1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2013 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 "termhooks.h"
107 #include "termopts.h"
108 #include "commands.h"
109 #include "keyboard.h"
110 #include "blockinput.h"
111 #include "dispextern.h"
112 #include "composite.h"
114 #include "sysselect.h"
115 #include "syssignal.h"
121 #ifdef HAVE_WINDOW_SYSTEM
123 #endif /* HAVE_WINDOW_SYSTEM */
126 #include "xgselect.h"
133 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
134 struct timespec
*, void *);
138 # define SOCK_CLOEXEC 0
143 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
146 close_on_exec (int fd
)
149 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
154 accept4 (int sockfd
, struct sockaddr
*addr
, socklen_t
*addrlen
, int flags
)
156 return close_on_exec (accept (sockfd
, addr
, addrlen
));
160 process_socket (int domain
, int type
, int protocol
)
162 return close_on_exec (socket (domain
, type
, protocol
));
165 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
168 /* Work around GCC 4.7.0 bug with strict overflow checking; see
169 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
170 These lines can be removed once the GCC bug is fixed. */
171 #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
172 # pragma GCC diagnostic ignored "-Wstrict-overflow"
175 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
176 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
177 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
178 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
179 Lisp_Object QCname
, QCtype
;
181 /* True if keyboard input is on hold, zero otherwise. */
183 static bool kbd_is_on_hold
;
185 /* Nonzero means don't run process sentinels. This is used
187 bool inhibit_sentinels
;
191 Lisp_Object Qprocessp
;
192 static Lisp_Object Qrun
, Qstop
, Qsignal
;
193 static Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
195 static Lisp_Object Qipv4
, Qdatagram
, Qseqpacket
;
196 static Lisp_Object Qreal
, Qnetwork
, Qserial
;
198 static Lisp_Object Qipv6
;
200 static Lisp_Object QCport
, QCprocess
;
202 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
203 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
204 static Lisp_Object QCbuffer
, QChost
, QCservice
;
205 static Lisp_Object QClocal
, QCremote
, QCcoding
;
206 static Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
207 static Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
208 static Lisp_Object Qlast_nonmenu_event
;
209 static Lisp_Object Qinternal_default_process_sentinel
;
210 static Lisp_Object Qinternal_default_process_filter
;
212 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
213 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
214 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
215 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
217 /* Number of events of change of status of a process. */
218 static EMACS_INT process_tick
;
219 /* Number of events for which the user or sentinel has been notified. */
220 static EMACS_INT update_tick
;
222 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
224 /* Only W32 has this, it really means that select can't take write mask. */
225 #ifdef BROKEN_NON_BLOCKING_CONNECT
226 #undef NON_BLOCKING_CONNECT
227 #define SELECT_CANT_DO_WRITE_MASK
229 #ifndef NON_BLOCKING_CONNECT
231 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
232 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
233 #define NON_BLOCKING_CONNECT
234 #endif /* EWOULDBLOCK || EINPROGRESS */
235 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
236 #endif /* HAVE_SELECT */
237 #endif /* NON_BLOCKING_CONNECT */
238 #endif /* BROKEN_NON_BLOCKING_CONNECT */
240 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
241 this system. We need to read full packets, so we need a
242 "non-destructive" select. So we require either native select,
243 or emulation of select using FIONREAD. */
245 #ifndef BROKEN_DATAGRAM_SOCKETS
246 # if defined HAVE_SELECT || defined USABLE_FIONREAD
247 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
248 # define DATAGRAM_SOCKETS
253 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
254 # define HAVE_SEQPACKET
257 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
258 #define ADAPTIVE_READ_BUFFERING
261 #ifdef ADAPTIVE_READ_BUFFERING
262 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
263 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
264 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
266 /* Number of processes which have a non-zero read_output_delay,
267 and therefore might be delayed for adaptive read buffering. */
269 static int process_output_delay_count
;
271 /* True if any process has non-nil read_output_skip. */
273 static bool process_output_skip
;
276 #define process_output_delay_count 0
279 static void create_process (Lisp_Object
, char **, Lisp_Object
);
281 static bool keyboard_bit_set (fd_set
*);
283 static void deactivate_process (Lisp_Object
);
284 static void status_notify (struct Lisp_Process
*);
285 static int read_process_output (Lisp_Object
, int);
286 static void handle_child_signal (int);
287 static void create_pty (Lisp_Object
);
289 /* If we support a window system, turn on the code to poll periodically
290 to detect C-g. It isn't actually used when doing interrupt input. */
291 #ifdef HAVE_WINDOW_SYSTEM
292 #define POLL_FOR_INPUT
295 static Lisp_Object
get_process (register Lisp_Object name
);
296 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
298 /* Mask of bits indicating the descriptors that we wait for input on. */
300 static fd_set input_wait_mask
;
302 /* Mask that excludes keyboard input descriptor(s). */
304 static fd_set non_keyboard_wait_mask
;
306 /* Mask that excludes process input descriptor(s). */
308 static fd_set non_process_wait_mask
;
310 /* Mask for selecting for write. */
312 static fd_set write_mask
;
314 #ifdef NON_BLOCKING_CONNECT
315 /* Mask of bits indicating the descriptors that we wait for connect to
316 complete on. Once they complete, they are removed from this mask
317 and added to the input_wait_mask and non_keyboard_wait_mask. */
319 static fd_set connect_wait_mask
;
321 /* Number of bits set in connect_wait_mask. */
322 static int num_pending_connects
;
323 #endif /* NON_BLOCKING_CONNECT */
325 /* The largest descriptor currently in use for a process object; -1 if none. */
326 static int max_process_desc
;
328 /* The largest descriptor currently in use for input; -1 if none. */
329 static int max_input_desc
;
331 /* Indexed by descriptor, gives the process (if any) for that descriptor */
332 static Lisp_Object chan_process
[FD_SETSIZE
];
334 /* Alist of elements (NAME . PROCESS) */
335 static Lisp_Object Vprocess_alist
;
337 /* Buffered-ahead input char from process, indexed by channel.
338 -1 means empty (no char is buffered).
339 Used on sys V where the only way to tell if there is any
340 output from the process is to read at least one char.
341 Always -1 on systems that support FIONREAD. */
343 static int proc_buffered_char
[FD_SETSIZE
];
345 /* Table of `struct coding-system' for each process. */
346 static struct coding_system
*proc_decode_coding_system
[FD_SETSIZE
];
347 static struct coding_system
*proc_encode_coding_system
[FD_SETSIZE
];
349 #ifdef DATAGRAM_SOCKETS
350 /* Table of `partner address' for datagram sockets. */
351 static struct sockaddr_and_len
{
354 } datagram_address
[FD_SETSIZE
];
355 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
356 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
358 #define DATAGRAM_CHAN_P(chan) (0)
359 #define DATAGRAM_CONN_P(proc) (0)
362 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
363 a `for' loop which iterates over processes from Vprocess_alist. */
365 #define FOR_EACH_PROCESS(list_var, proc_var) \
366 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
368 /* These setters are used only in this file, so they can be private. */
370 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
375 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
380 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
382 p
->decode_coding_system
= val
;
385 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
387 p
->decoding_buf
= val
;
390 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
392 p
->encode_coding_system
= val
;
395 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
397 p
->encoding_buf
= val
;
400 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
402 p
->filter
= NILP (val
) ? Qinternal_default_process_filter
: val
;
405 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
410 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
415 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
420 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
425 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
427 p
->sentinel
= NILP (val
) ? Qinternal_default_process_sentinel
: val
;
430 pset_status (struct Lisp_Process
*p
, Lisp_Object val
)
435 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
440 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
445 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
447 p
->write_queue
= val
;
452 static struct fd_callback_data
458 int condition
; /* mask of the defines above. */
459 } fd_callback_info
[FD_SETSIZE
];
462 /* Add a file descriptor FD to be monitored for when read is possible.
463 When read is possible, call FUNC with argument DATA. */
466 add_read_fd (int fd
, fd_callback func
, void *data
)
468 eassert (fd
< FD_SETSIZE
);
469 add_keyboard_wait_descriptor (fd
);
471 fd_callback_info
[fd
].func
= func
;
472 fd_callback_info
[fd
].data
= data
;
473 fd_callback_info
[fd
].condition
|= FOR_READ
;
476 /* Stop monitoring file descriptor FD for when read is possible. */
479 delete_read_fd (int fd
)
481 eassert (fd
< FD_SETSIZE
);
482 delete_keyboard_wait_descriptor (fd
);
484 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
485 if (fd_callback_info
[fd
].condition
== 0)
487 fd_callback_info
[fd
].func
= 0;
488 fd_callback_info
[fd
].data
= 0;
492 /* Add a file descriptor FD to be monitored for when write is possible.
493 When write is possible, call FUNC with argument DATA. */
496 add_write_fd (int fd
, fd_callback func
, void *data
)
498 eassert (fd
< FD_SETSIZE
);
499 FD_SET (fd
, &write_mask
);
500 if (fd
> max_input_desc
)
503 fd_callback_info
[fd
].func
= func
;
504 fd_callback_info
[fd
].data
= data
;
505 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
508 /* FD is no longer an input descriptor; update max_input_desc accordingly. */
511 delete_input_desc (int fd
)
513 if (fd
== max_input_desc
)
517 while (0 <= fd
&& ! (FD_ISSET (fd
, &input_wait_mask
)
518 || FD_ISSET (fd
, &write_mask
)));
524 /* Stop monitoring file descriptor FD for when write is possible. */
527 delete_write_fd (int fd
)
529 eassert (fd
< FD_SETSIZE
);
530 FD_CLR (fd
, &write_mask
);
531 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
532 if (fd_callback_info
[fd
].condition
== 0)
534 fd_callback_info
[fd
].func
= 0;
535 fd_callback_info
[fd
].data
= 0;
536 delete_input_desc (fd
);
541 /* Compute the Lisp form of the process status, p->status, from
542 the numeric status that was returned by `wait'. */
544 static Lisp_Object
status_convert (int);
547 update_status (struct Lisp_Process
*p
)
549 eassert (p
->raw_status_new
);
550 pset_status (p
, status_convert (p
->raw_status
));
551 p
->raw_status_new
= 0;
554 /* Convert a process status word in Unix format to
555 the list that we use internally. */
558 status_convert (int w
)
561 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
562 else if (WIFEXITED (w
))
563 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
564 WCOREDUMP (w
) ? Qt
: Qnil
));
565 else if (WIFSIGNALED (w
))
566 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
567 WCOREDUMP (w
) ? Qt
: Qnil
));
572 /* Given a status-list, extract the three pieces of information
573 and store them individually through the three pointers. */
576 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, bool *coredump
)
590 *code
= XFASTINT (XCAR (tem
));
592 *coredump
= !NILP (tem
);
596 /* Return a string describing a process status list. */
599 status_message (struct Lisp_Process
*p
)
601 Lisp_Object status
= p
->status
;
605 Lisp_Object string
, string2
;
607 decode_status (status
, &symbol
, &code
, &coredump
);
609 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
612 synchronize_system_messages_locale ();
613 signame
= strsignal (code
);
615 string
= build_string ("unknown");
620 string
= build_unibyte_string (signame
);
621 if (! NILP (Vlocale_coding_system
))
622 string
= (code_convert_string_norecord
623 (string
, Vlocale_coding_system
, 0));
624 c1
= STRING_CHAR (SDATA (string
));
627 Faset (string
, make_number (0), make_number (c2
));
629 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
630 return concat2 (string
, string2
);
632 else if (EQ (symbol
, Qexit
))
635 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
637 return build_string ("finished\n");
638 string
= Fnumber_to_string (make_number (code
));
639 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
640 return concat3 (build_string ("exited abnormally with code "),
643 else if (EQ (symbol
, Qfailed
))
645 string
= Fnumber_to_string (make_number (code
));
646 string2
= build_string ("\n");
647 return concat3 (build_string ("failed with code "),
651 return Fcopy_sequence (Fsymbol_name (symbol
));
654 enum { PTY_NAME_SIZE
= 24 };
656 /* Open an available pty, returning a file descriptor.
657 Store into PTY_NAME the file name of the terminal corresponding to the pty.
658 Return -1 on failure. */
661 allocate_pty (char pty_name
[PTY_NAME_SIZE
])
670 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
671 for (i
= 0; i
< 16; i
++)
674 #ifdef PTY_NAME_SPRINTF
677 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
678 #endif /* no PTY_NAME_SPRINTF */
682 #else /* no PTY_OPEN */
683 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
684 #endif /* no PTY_OPEN */
689 /* Set FD's close-on-exec flag. This is needed even if
690 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
691 doesn't require support for that combination.
692 Multithreaded platforms where posix_openpt ignores
693 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
694 have a race condition between the PTY_OPEN and here. */
695 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
697 /* check to make certain that both sides are available
698 this avoids a nasty yet stupid bug in rlogins */
699 #ifdef PTY_TTY_NAME_SPRINTF
702 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
703 #endif /* no PTY_TTY_NAME_SPRINTF */
704 if (faccessat (AT_FDCWD
, pty_name
, R_OK
| W_OK
, AT_EACCESS
) != 0)
717 #endif /* HAVE_PTYS */
722 make_process (Lisp_Object name
)
724 register Lisp_Object val
, tem
, name1
;
725 register struct Lisp_Process
*p
;
726 char suffix
[sizeof "<>" + INT_STRLEN_BOUND (printmax_t
)];
729 p
= allocate_process ();
730 /* Initialize Lisp data. Note that allocate_process initializes all
731 Lisp data to nil, so do it only for slots which should not be nil. */
732 pset_status (p
, Qrun
);
733 pset_mark (p
, Fmake_marker ());
735 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
736 non-Lisp data, so do it only for slots which should not be zero. */
739 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
743 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
746 /* If name is already in use, modify it until it is unused. */
751 tem
= Fget_process (name1
);
752 if (NILP (tem
)) break;
753 name1
= concat2 (name
, make_formatted_string (suffix
, "<%"pMd
">", i
));
757 pset_sentinel (p
, Qinternal_default_process_sentinel
);
758 pset_filter (p
, Qinternal_default_process_filter
);
759 XSETPROCESS (val
, p
);
760 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
765 remove_process (register Lisp_Object proc
)
767 register Lisp_Object pair
;
769 pair
= Frassq (proc
, Vprocess_alist
);
770 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
772 deactivate_process (proc
);
776 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
777 doc
: /* Return t if OBJECT is a process. */)
780 return PROCESSP (object
) ? Qt
: Qnil
;
783 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
784 doc
: /* Return the process named NAME, or nil if there is none. */)
785 (register Lisp_Object name
)
790 return Fcdr (Fassoc (name
, Vprocess_alist
));
793 /* This is how commands for the user decode process arguments. It
794 accepts a process, a process name, a buffer, a buffer name, or nil.
795 Buffers denote the first process in the buffer, and nil denotes the
799 get_process (register Lisp_Object name
)
801 register Lisp_Object proc
, obj
;
804 obj
= Fget_process (name
);
806 obj
= Fget_buffer (name
);
808 error ("Process %s does not exist", SDATA (name
));
810 else if (NILP (name
))
811 obj
= Fcurrent_buffer ();
815 /* Now obj should be either a (live) buffer object or a process object. */
816 if (BUFFERP (obj
) && !NILP (BVAR (XBUFFER (obj
), name
)))
818 proc
= Fget_buffer_process (obj
);
820 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
831 /* Fdelete_process promises to immediately forget about the process, but in
832 reality, Emacs needs to remember those processes until they have been
833 treated by the SIGCHLD handler and waitpid has been invoked on them;
834 otherwise they might fill up the kernel's process table.
836 Some processes created by call-process are also put onto this list.
838 Members of this list are (process-ID . filename) pairs. The
839 process-ID is a number; the filename, if a string, is a file that
840 needs to be removed after the process exits. */
841 static Lisp_Object deleted_pid_list
;
844 record_deleted_pid (pid_t pid
, Lisp_Object filename
)
846 deleted_pid_list
= Fcons (Fcons (make_fixnum_or_float (pid
), filename
),
847 /* GC treated elements set to nil. */
848 Fdelq (Qnil
, deleted_pid_list
));
852 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
853 doc
: /* Delete PROCESS: kill it and forget about it immediately.
854 PROCESS may be a process, a buffer, the name of a process or buffer, or
855 nil, indicating the current buffer's process. */)
856 (register Lisp_Object process
)
858 register struct Lisp_Process
*p
;
860 process
= get_process (process
);
861 p
= XPROCESS (process
);
863 p
->raw_status_new
= 0;
864 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
866 pset_status (p
, list2 (Qexit
, make_number (0)));
867 p
->tick
= ++process_tick
;
869 redisplay_preserve_echo_area (13);
874 record_kill_process (p
, Qnil
);
878 /* Update P's status, since record_kill_process will make the
879 SIGCHLD handler update deleted_pid_list, not *P. */
881 if (p
->raw_status_new
)
883 symbol
= CONSP (p
->status
) ? XCAR (p
->status
) : p
->status
;
884 if (! (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)))
885 pset_status (p
, list2 (Qsignal
, make_number (SIGKILL
)));
887 p
->tick
= ++process_tick
;
889 redisplay_preserve_echo_area (13);
892 remove_process (process
);
896 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
897 doc
: /* Return the status of PROCESS.
898 The returned value is one of the following symbols:
899 run -- for a process that is running.
900 stop -- for a process stopped but continuable.
901 exit -- for a process that has exited.
902 signal -- for a process that has got a fatal signal.
903 open -- for a network stream connection that is open.
904 listen -- for a network stream server that is listening.
905 closed -- for a network stream connection that is closed.
906 connect -- when waiting for a non-blocking connection to complete.
907 failed -- when a non-blocking connection has failed.
908 nil -- if arg is a process name and no such process exists.
909 PROCESS may be a process, a buffer, the name of a process, or
910 nil, indicating the current buffer's process. */)
911 (register Lisp_Object process
)
913 register struct Lisp_Process
*p
;
914 register Lisp_Object status
;
916 if (STRINGP (process
))
917 process
= Fget_process (process
);
919 process
= get_process (process
);
924 p
= XPROCESS (process
);
925 if (p
->raw_status_new
)
929 status
= XCAR (status
);
930 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
932 if (EQ (status
, Qexit
))
934 else if (EQ (p
->command
, Qt
))
936 else if (EQ (status
, Qrun
))
942 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
944 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
945 If PROCESS has not yet exited or died, return 0. */)
946 (register Lisp_Object process
)
948 CHECK_PROCESS (process
);
949 if (XPROCESS (process
)->raw_status_new
)
950 update_status (XPROCESS (process
));
951 if (CONSP (XPROCESS (process
)->status
))
952 return XCAR (XCDR (XPROCESS (process
)->status
));
953 return make_number (0);
956 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
957 doc
: /* Return the process id of PROCESS.
958 This is the pid of the external process which PROCESS uses or talks to.
959 For a network connection, this value is nil. */)
960 (register Lisp_Object process
)
964 CHECK_PROCESS (process
);
965 pid
= XPROCESS (process
)->pid
;
966 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
969 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
970 doc
: /* Return the name of PROCESS, as a string.
971 This is the name of the program invoked in PROCESS,
972 possibly modified to make it unique among process names. */)
973 (register Lisp_Object process
)
975 CHECK_PROCESS (process
);
976 return XPROCESS (process
)->name
;
979 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
980 doc
: /* Return the command that was executed to start PROCESS.
981 This is a list of strings, the first string being the program executed
982 and the rest of the strings being the arguments given to it.
983 For a network or serial process, this is nil (process is running) or t
984 \(process is stopped). */)
985 (register Lisp_Object process
)
987 CHECK_PROCESS (process
);
988 return XPROCESS (process
)->command
;
991 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
992 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
993 This is the terminal that the process itself reads and writes on,
994 not the name of the pty that Emacs uses to talk with that terminal. */)
995 (register Lisp_Object process
)
997 CHECK_PROCESS (process
);
998 return XPROCESS (process
)->tty_name
;
1001 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
1003 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1005 (register Lisp_Object process
, Lisp_Object buffer
)
1007 struct Lisp_Process
*p
;
1009 CHECK_PROCESS (process
);
1011 CHECK_BUFFER (buffer
);
1012 p
= XPROCESS (process
);
1013 pset_buffer (p
, buffer
);
1014 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1015 pset_childp (p
, Fplist_put (p
->childp
, QCbuffer
, buffer
));
1016 setup_process_coding_systems (process
);
1020 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
1022 doc
: /* Return the buffer PROCESS is associated with.
1023 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
1024 (register Lisp_Object process
)
1026 CHECK_PROCESS (process
);
1027 return XPROCESS (process
)->buffer
;
1030 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
1032 doc
: /* Return the marker for the end of the last output from PROCESS. */)
1033 (register Lisp_Object process
)
1035 CHECK_PROCESS (process
);
1036 return XPROCESS (process
)->mark
;
1039 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1041 doc
: /* Give PROCESS the filter function FILTER; nil means default.
1042 A value of t means stop accepting output from the process.
1044 When a process has a non-default filter, its buffer is not used for output.
1045 Instead, each time it does output, the entire string of output is
1046 passed to the filter.
1048 The filter gets two arguments: the process and the string of output.
1049 The string argument is normally a multibyte string, except:
1050 - if the process' input coding system is no-conversion or raw-text,
1051 it is a unibyte string (the non-converted input), or else
1052 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1053 string (the result of converting the decoded input multibyte
1054 string to unibyte with `string-make-unibyte'). */)
1055 (register Lisp_Object process
, Lisp_Object filter
)
1057 struct Lisp_Process
*p
;
1059 CHECK_PROCESS (process
);
1060 p
= XPROCESS (process
);
1062 /* Don't signal an error if the process' input file descriptor
1063 is closed. This could make debugging Lisp more difficult,
1064 for example when doing something like
1066 (setq process (start-process ...))
1068 (set-process-filter process ...) */
1071 filter
= Qinternal_default_process_filter
;
1075 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1077 FD_CLR (p
->infd
, &input_wait_mask
);
1078 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1080 else if (EQ (p
->filter
, Qt
)
1081 /* Network or serial process not stopped: */
1082 && !EQ (p
->command
, Qt
))
1084 FD_SET (p
->infd
, &input_wait_mask
);
1085 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1089 pset_filter (p
, filter
);
1090 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1091 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1092 setup_process_coding_systems (process
);
1096 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1098 doc
: /* Return the filter function of PROCESS.
1099 See `set-process-filter' for more info on filter functions. */)
1100 (register Lisp_Object process
)
1102 CHECK_PROCESS (process
);
1103 return XPROCESS (process
)->filter
;
1106 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1108 doc
: /* Give PROCESS the sentinel SENTINEL; nil for default.
1109 The sentinel is called as a function when the process changes state.
1110 It gets two arguments: the process, and a string describing the change. */)
1111 (register Lisp_Object process
, Lisp_Object sentinel
)
1113 struct Lisp_Process
*p
;
1115 CHECK_PROCESS (process
);
1116 p
= XPROCESS (process
);
1118 if (NILP (sentinel
))
1119 sentinel
= Qinternal_default_process_sentinel
;
1121 pset_sentinel (p
, sentinel
);
1122 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1123 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1127 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1129 doc
: /* Return the sentinel of PROCESS.
1130 See `set-process-sentinel' for more info on sentinels. */)
1131 (register Lisp_Object process
)
1133 CHECK_PROCESS (process
);
1134 return XPROCESS (process
)->sentinel
;
1137 DEFUN ("set-process-window-size", Fset_process_window_size
,
1138 Sset_process_window_size
, 3, 3, 0,
1139 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1140 (Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1142 CHECK_PROCESS (process
);
1144 /* All known platforms store window sizes as 'unsigned short'. */
1145 CHECK_RANGED_INTEGER (height
, 0, USHRT_MAX
);
1146 CHECK_RANGED_INTEGER (width
, 0, USHRT_MAX
);
1148 if (XPROCESS (process
)->infd
< 0
1149 || (set_window_size (XPROCESS (process
)->infd
,
1150 XINT (height
), XINT (width
))
1157 DEFUN ("set-process-inherit-coding-system-flag",
1158 Fset_process_inherit_coding_system_flag
,
1159 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1160 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1161 If the second argument FLAG is non-nil, then the variable
1162 `buffer-file-coding-system' of the buffer associated with PROCESS
1163 will be bound to the value of the coding system used to decode
1166 This is useful when the coding system specified for the process buffer
1167 leaves either the character code conversion or the end-of-line conversion
1168 unspecified, or if the coding system used to decode the process output
1169 is more appropriate for saving the process buffer.
1171 Binding the variable `inherit-process-coding-system' to non-nil before
1172 starting the process is an alternative way of setting the inherit flag
1173 for the process which will run.
1175 This function returns FLAG. */)
1176 (register Lisp_Object process
, Lisp_Object flag
)
1178 CHECK_PROCESS (process
);
1179 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1183 DEFUN ("set-process-query-on-exit-flag",
1184 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1186 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1187 If the second argument FLAG is non-nil, Emacs will query the user before
1188 exiting or killing a buffer if PROCESS is running. This function
1190 (register Lisp_Object process
, Lisp_Object flag
)
1192 CHECK_PROCESS (process
);
1193 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1197 DEFUN ("process-query-on-exit-flag",
1198 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1200 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1201 (register Lisp_Object process
)
1203 CHECK_PROCESS (process
);
1204 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1207 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1209 doc
: /* Return the contact info of PROCESS; t for a real child.
1210 For a network or serial connection, the value depends on the optional
1211 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1212 SERVICE) for a network connection or (PORT SPEED) for a serial
1213 connection. If KEY is t, the complete contact information for the
1214 connection is returned, else the specific value for the keyword KEY is
1215 returned. See `make-network-process' or `make-serial-process' for a
1216 list of keywords. */)
1217 (register Lisp_Object process
, Lisp_Object key
)
1219 Lisp_Object contact
;
1221 CHECK_PROCESS (process
);
1222 contact
= XPROCESS (process
)->childp
;
1224 #ifdef DATAGRAM_SOCKETS
1225 if (DATAGRAM_CONN_P (process
)
1226 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1227 contact
= Fplist_put (contact
, QCremote
,
1228 Fprocess_datagram_address (process
));
1231 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1233 if (NILP (key
) && NETCONN_P (process
))
1234 return list2 (Fplist_get (contact
, QChost
),
1235 Fplist_get (contact
, QCservice
));
1236 if (NILP (key
) && SERIALCONN_P (process
))
1237 return list2 (Fplist_get (contact
, QCport
),
1238 Fplist_get (contact
, QCspeed
));
1239 return Fplist_get (contact
, key
);
1242 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1244 doc
: /* Return the plist of PROCESS. */)
1245 (register Lisp_Object process
)
1247 CHECK_PROCESS (process
);
1248 return XPROCESS (process
)->plist
;
1251 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1253 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1254 (register Lisp_Object process
, Lisp_Object plist
)
1256 CHECK_PROCESS (process
);
1259 pset_plist (XPROCESS (process
), plist
);
1263 #if 0 /* Turned off because we don't currently record this info
1264 in the process. Perhaps add it. */
1265 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1266 doc
: /* Return the connection type of PROCESS.
1267 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1268 a socket connection. */)
1269 (Lisp_Object process
)
1271 return XPROCESS (process
)->type
;
1275 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1276 doc
: /* Return the connection type of PROCESS.
1277 The value is either the symbol `real', `network', or `serial'.
1278 PROCESS may be a process, a buffer, the name of a process or buffer, or
1279 nil, indicating the current buffer's process. */)
1280 (Lisp_Object process
)
1283 proc
= get_process (process
);
1284 return XPROCESS (proc
)->type
;
1287 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1289 doc
: /* Convert network ADDRESS from internal format to a string.
1290 A 4 or 5 element vector represents an IPv4 address (with port number).
1291 An 8 or 9 element vector represents an IPv6 address (with port number).
1292 If optional second argument OMIT-PORT is non-nil, don't include a port
1293 number in the string, even when present in ADDRESS.
1294 Returns nil if format of ADDRESS is invalid. */)
1295 (Lisp_Object address
, Lisp_Object omit_port
)
1300 if (STRINGP (address
)) /* AF_LOCAL */
1303 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1305 register struct Lisp_Vector
*p
= XVECTOR (address
);
1306 ptrdiff_t size
= p
->header
.size
;
1307 Lisp_Object args
[10];
1310 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1312 args
[0] = build_string ("%d.%d.%d.%d");
1317 args
[0] = build_string ("%d.%d.%d.%d:%d");
1320 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1322 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1327 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1333 for (i
= 0; i
< nargs
; i
++)
1335 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1338 if (nargs
<= 5 /* IPv4 */
1339 && i
< 4 /* host, not port */
1340 && XINT (p
->contents
[i
]) > 255)
1343 args
[i
+1] = p
->contents
[i
];
1346 return Fformat (nargs
+1, args
);
1349 if (CONSP (address
))
1351 Lisp_Object args
[2];
1352 args
[0] = build_string ("<Family %d>");
1353 args
[1] = Fcar (address
);
1354 return Fformat (2, args
);
1360 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1361 doc
: /* Return a list of all processes that are Emacs sub-processes. */)
1364 return Fmapcar (Qcdr
, Vprocess_alist
);
1367 /* Starting asynchronous inferior processes. */
1369 static void start_process_unwind (Lisp_Object proc
);
1371 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1372 doc
: /* Start a program in a subprocess. Return the process object for it.
1373 NAME is name for process. It is modified if necessary to make it unique.
1374 BUFFER is the buffer (or buffer name) to associate with the process.
1376 Process output (both standard output and standard error streams) goes
1377 at end of BUFFER, unless you specify an output stream or filter
1378 function to handle the output. BUFFER may also be nil, meaning that
1379 this process is not associated with any buffer.
1381 PROGRAM is the program file name. It is searched for in `exec-path'
1382 (which see). If nil, just associate a pty with the buffer. Remaining
1383 arguments are strings to give program as arguments.
1385 If you want to separate standard output from standard error, invoke
1386 the command through a shell and redirect one of them using the shell
1389 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1390 (ptrdiff_t nargs
, Lisp_Object
*args
)
1392 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1393 register unsigned char **new_argv
;
1395 ptrdiff_t count
= SPECPDL_INDEX ();
1399 buffer
= Fget_buffer_create (buffer
);
1401 /* Make sure that the child will be able to chdir to the current
1402 buffer's current directory, or its unhandled equivalent. We
1403 can't just have the child check for an error when it does the
1404 chdir, since it's in a vfork.
1406 We have to GCPRO around this because Fexpand_file_name and
1407 Funhandled_file_name_directory might call a file name handling
1408 function. The argument list is protected by the caller, so all
1409 we really have to worry about is buffer. */
1411 struct gcpro gcpro1
;
1413 current_dir
= encode_current_directory ();
1418 CHECK_STRING (name
);
1422 if (!NILP (program
))
1423 CHECK_STRING (program
);
1425 proc
= make_process (name
);
1426 /* If an error occurs and we can't start the process, we want to
1427 remove it from the process list. This means that each error
1428 check in create_process doesn't need to call remove_process
1429 itself; it's all taken care of here. */
1430 record_unwind_protect (start_process_unwind
, proc
);
1432 pset_childp (XPROCESS (proc
), Qt
);
1433 pset_plist (XPROCESS (proc
), Qnil
);
1434 pset_type (XPROCESS (proc
), Qreal
);
1435 pset_buffer (XPROCESS (proc
), buffer
);
1436 pset_sentinel (XPROCESS (proc
), Qinternal_default_process_sentinel
);
1437 pset_filter (XPROCESS (proc
), Qinternal_default_process_filter
);
1438 pset_command (XPROCESS (proc
), Flist (nargs
- 2, args
+ 2));
1441 /* AKA GNUTLS_INITSTAGE(proc). */
1442 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1443 pset_gnutls_cred_type (XPROCESS (proc
), Qnil
);
1446 #ifdef ADAPTIVE_READ_BUFFERING
1447 XPROCESS (proc
)->adaptive_read_buffering
1448 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1449 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1452 /* Make the process marker point into the process buffer (if any). */
1453 if (BUFFERP (buffer
))
1454 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1455 BUF_ZV (XBUFFER (buffer
)),
1456 BUF_ZV_BYTE (XBUFFER (buffer
)));
1459 /* Decide coding systems for communicating with the process. Here
1460 we don't setup the structure coding_system nor pay attention to
1461 unibyte mode. They are done in create_process. */
1463 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1464 Lisp_Object coding_systems
= Qt
;
1465 Lisp_Object val
, *args2
;
1466 struct gcpro gcpro1
, gcpro2
;
1468 val
= Vcoding_system_for_read
;
1471 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1472 args2
[0] = Qstart_process
;
1473 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1474 GCPRO2 (proc
, current_dir
);
1475 if (!NILP (program
))
1476 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1478 if (CONSP (coding_systems
))
1479 val
= XCAR (coding_systems
);
1480 else if (CONSP (Vdefault_process_coding_system
))
1481 val
= XCAR (Vdefault_process_coding_system
);
1483 pset_decode_coding_system (XPROCESS (proc
), val
);
1485 val
= Vcoding_system_for_write
;
1488 if (EQ (coding_systems
, Qt
))
1490 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1491 args2
[0] = Qstart_process
;
1492 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1493 GCPRO2 (proc
, current_dir
);
1494 if (!NILP (program
))
1495 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1498 if (CONSP (coding_systems
))
1499 val
= XCDR (coding_systems
);
1500 else if (CONSP (Vdefault_process_coding_system
))
1501 val
= XCDR (Vdefault_process_coding_system
);
1503 pset_encode_coding_system (XPROCESS (proc
), val
);
1504 /* Note: At this moment, the above coding system may leave
1505 text-conversion or eol-conversion unspecified. They will be
1506 decided after we read output from the process and decode it by
1507 some coding system, or just before we actually send a text to
1512 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1513 XPROCESS (proc
)->decoding_carryover
= 0;
1514 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1516 XPROCESS (proc
)->inherit_coding_system_flag
1517 = !(NILP (buffer
) || !inherit_process_coding_system
);
1519 if (!NILP (program
))
1521 /* If program file name is not absolute, search our path for it.
1522 Put the name we will really use in TEM. */
1523 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1524 && !(SCHARS (program
) > 1
1525 && IS_DEVICE_SEP (SREF (program
, 1))))
1527 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1530 GCPRO4 (name
, program
, buffer
, current_dir
);
1531 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1534 report_file_error ("Searching for program", program
);
1535 tem
= Fexpand_file_name (tem
, Qnil
);
1539 if (!NILP (Ffile_directory_p (program
)))
1540 error ("Specified program for new process is a directory");
1544 /* If program file name starts with /: for quoting a magic name,
1546 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1547 && SREF (tem
, 1) == ':')
1548 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1551 Lisp_Object arg_encoding
= Qnil
;
1552 struct gcpro gcpro1
;
1555 /* Encode the file name and put it in NEW_ARGV.
1556 That's where the child will use it to execute the program. */
1557 tem
= list1 (ENCODE_FILE (tem
));
1559 /* Here we encode arguments by the coding system used for sending
1560 data to the process. We don't support using different coding
1561 systems for encoding arguments and for encoding data sent to the
1564 for (i
= 3; i
< nargs
; i
++)
1566 tem
= Fcons (args
[i
], tem
);
1567 CHECK_STRING (XCAR (tem
));
1568 if (STRING_MULTIBYTE (XCAR (tem
)))
1570 if (NILP (arg_encoding
))
1571 arg_encoding
= (complement_process_encoding_system
1572 (XPROCESS (proc
)->encode_coding_system
));
1574 code_convert_string_norecord
1575 (XCAR (tem
), arg_encoding
, 1));
1582 /* Now that everything is encoded we can collect the strings into
1584 new_argv
= alloca ((nargs
- 1) * sizeof *new_argv
);
1585 new_argv
[nargs
- 2] = 0;
1587 for (i
= nargs
- 2; i
-- != 0; )
1589 new_argv
[i
] = SDATA (XCAR (tem
));
1593 create_process (proc
, (char **) new_argv
, current_dir
);
1598 return unbind_to (count
, proc
);
1601 /* This function is the unwind_protect form for Fstart_process. If
1602 PROC doesn't have its pid set, then we know someone has signaled
1603 an error and the process wasn't started successfully, so we should
1604 remove it from the process list. */
1606 start_process_unwind (Lisp_Object proc
)
1608 if (!PROCESSP (proc
))
1611 /* Was PROC started successfully?
1612 -2 is used for a pty with no process, eg for gdb. */
1613 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1614 remove_process (proc
);
1617 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1620 close_process_fd (int *fd_addr
)
1630 /* Indexes of file descriptors in open_fds. */
1633 /* The pipe from Emacs to its subprocess. */
1635 WRITE_TO_SUBPROCESS
,
1637 /* The main pipe from the subprocess to Emacs. */
1638 READ_FROM_SUBPROCESS
,
1641 /* The pipe from the subprocess to Emacs that is closed when the
1642 subprocess execs. */
1643 READ_FROM_EXEC_MONITOR
,
1647 verify (PROCESS_OPEN_FDS
== EXEC_MONITOR_OUTPUT
+ 1);
1650 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1652 struct Lisp_Process
*p
= XPROCESS (process
);
1653 int inchannel
, outchannel
;
1656 int forkin
, forkout
;
1658 char pty_name
[PTY_NAME_SIZE
];
1659 Lisp_Object lisp_pty_name
= Qnil
;
1661 inchannel
= outchannel
= -1;
1663 if (!NILP (Vprocess_connection_type
))
1664 outchannel
= inchannel
= allocate_pty (pty_name
);
1668 p
->open_fd
[READ_FROM_SUBPROCESS
] = inchannel
;
1669 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1670 /* On most USG systems it does not work to open the pty's tty here,
1671 then close it and reopen it in the child. */
1672 /* Don't let this terminal become our controlling terminal
1673 (in case we don't have one). */
1674 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1676 report_file_error ("Opening pty", Qnil
);
1677 p
->open_fd
[SUBPROCESS_STDIN
] = forkin
;
1679 forkin
= forkout
= -1;
1680 #endif /* not USG, or USG_SUBTTY_WORKS */
1682 lisp_pty_name
= build_string (pty_name
);
1686 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
1687 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
1688 report_file_error ("Creating pipe", Qnil
);
1689 forkin
= p
->open_fd
[SUBPROCESS_STDIN
];
1690 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
1691 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
1692 forkout
= p
->open_fd
[SUBPROCESS_STDOUT
];
1696 if (emacs_pipe (p
->open_fd
+ READ_FROM_EXEC_MONITOR
) != 0)
1697 report_file_error ("Creating pipe", Qnil
);
1700 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1701 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1703 /* Record this as an active process, with its channels. */
1704 chan_process
[inchannel
] = process
;
1705 p
->infd
= inchannel
;
1706 p
->outfd
= outchannel
;
1708 /* Previously we recorded the tty descriptor used in the subprocess.
1709 It was only used for getting the foreground tty process, so now
1710 we just reopen the device (see emacs_get_tty_pgrp) as this is
1711 more portable (see USG_SUBTTY_WORKS above). */
1713 p
->pty_flag
= pty_flag
;
1714 pset_status (p
, Qrun
);
1716 FD_SET (inchannel
, &input_wait_mask
);
1717 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1718 if (inchannel
> max_process_desc
)
1719 max_process_desc
= inchannel
;
1721 /* This may signal an error. */
1722 setup_process_coding_systems (process
);
1725 block_child_signal ();
1728 /* vfork, and prevent local vars from being clobbered by the vfork. */
1730 Lisp_Object
volatile current_dir_volatile
= current_dir
;
1731 Lisp_Object
volatile lisp_pty_name_volatile
= lisp_pty_name
;
1732 char **volatile new_argv_volatile
= new_argv
;
1733 int volatile forkin_volatile
= forkin
;
1734 int volatile forkout_volatile
= forkout
;
1735 struct Lisp_Process
*p_volatile
= p
;
1739 current_dir
= current_dir_volatile
;
1740 lisp_pty_name
= lisp_pty_name_volatile
;
1741 new_argv
= new_argv_volatile
;
1742 forkin
= forkin_volatile
;
1743 forkout
= forkout_volatile
;
1746 pty_flag
= p
->pty_flag
;
1750 #endif /* not WINDOWSNT */
1752 int xforkin
= forkin
;
1753 int xforkout
= forkout
;
1755 /* Make the pty be the controlling terminal of the process. */
1757 /* First, disconnect its current controlling terminal. */
1758 /* We tried doing setsid only if pty_flag, but it caused
1759 process_set_signal to fail on SGI when using a pipe. */
1761 /* Make the pty's terminal the controlling terminal. */
1762 if (pty_flag
&& xforkin
>= 0)
1765 /* We ignore the return value
1766 because faith@cs.unc.edu says that is necessary on Linux. */
1767 ioctl (xforkin
, TIOCSCTTY
, 0);
1770 #if defined (LDISC1)
1771 if (pty_flag
&& xforkin
>= 0)
1774 tcgetattr (xforkin
, &t
);
1776 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1777 emacs_perror ("create_process/tcsetattr LDISC1");
1780 #if defined (NTTYDISC) && defined (TIOCSETD)
1781 if (pty_flag
&& xforkin
>= 0)
1783 /* Use new line discipline. */
1784 int ldisc
= NTTYDISC
;
1785 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1790 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1791 can do TIOCSPGRP only to the process's controlling tty. */
1794 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1795 I can't test it since I don't have 4.3. */
1796 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1799 ioctl (j
, TIOCNOTTY
, 0);
1803 #endif /* TIOCNOTTY */
1805 #if !defined (DONT_REOPEN_PTY)
1806 /*** There is a suggestion that this ought to be a
1807 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
1808 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1809 that system does seem to need this code, even though
1810 both TIOCSCTTY is defined. */
1811 /* Now close the pty (if we had it open) and reopen it.
1812 This makes the pty the controlling terminal of the subprocess. */
1816 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
1819 emacs_close (xforkin
);
1820 xforkout
= xforkin
= emacs_open (SSDATA (lisp_pty_name
), O_RDWR
, 0);
1824 emacs_perror (SSDATA (lisp_pty_name
));
1825 _exit (EXIT_CANCELED
);
1829 #endif /* not DONT_REOPEN_PTY */
1831 #ifdef SETUP_SLAVE_PTY
1836 #endif /* SETUP_SLAVE_PTY */
1837 #endif /* HAVE_PTYS */
1839 signal (SIGINT
, SIG_DFL
);
1840 signal (SIGQUIT
, SIG_DFL
);
1842 /* Emacs ignores SIGPIPE, but the child should not. */
1843 signal (SIGPIPE
, SIG_DFL
);
1845 /* Stop blocking SIGCHLD in the child. */
1846 unblock_child_signal ();
1849 child_setup_tty (xforkout
);
1851 pid
= child_setup (xforkin
, xforkout
, xforkout
, new_argv
, 1, current_dir
);
1852 #else /* not WINDOWSNT */
1853 child_setup (xforkin
, xforkout
, xforkout
, new_argv
, 1, current_dir
);
1854 #endif /* not WINDOWSNT */
1857 /* Back in the parent process. */
1859 vfork_errno
= errno
;
1864 /* Stop blocking in the parent. */
1865 unblock_child_signal ();
1869 report_file_errno ("Doing vfork", Qnil
, vfork_errno
);
1872 /* vfork succeeded. */
1874 /* Close the pipe ends that the child uses, or the child's pty. */
1875 close_process_fd (&p
->open_fd
[SUBPROCESS_STDIN
]);
1876 close_process_fd (&p
->open_fd
[SUBPROCESS_STDOUT
]);
1879 register_child (pid
, inchannel
);
1880 #endif /* WINDOWSNT */
1882 pset_tty_name (p
, lisp_pty_name
);
1885 /* Wait for child_setup to complete in case that vfork is
1886 actually defined as fork. The descriptor
1887 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
1888 of a pipe is closed at the child side either by close-on-exec
1889 on successful execve or the _exit call in child_setup. */
1893 close_process_fd (&p
->open_fd
[EXEC_MONITOR_OUTPUT
]);
1894 emacs_read (p
->open_fd
[READ_FROM_EXEC_MONITOR
], &dummy
, 1);
1895 close_process_fd (&p
->open_fd
[READ_FROM_EXEC_MONITOR
]);
1902 create_pty (Lisp_Object process
)
1904 struct Lisp_Process
*p
= XPROCESS (process
);
1905 char pty_name
[PTY_NAME_SIZE
];
1906 int pty_fd
= NILP (Vprocess_connection_type
) ? -1 : allocate_pty (pty_name
);
1910 p
->open_fd
[SUBPROCESS_STDIN
] = pty_fd
;
1911 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1912 /* On most USG systems it does not work to open the pty's tty here,
1913 then close it and reopen it in the child. */
1914 /* Don't let this terminal become our controlling terminal
1915 (in case we don't have one). */
1916 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1918 report_file_error ("Opening pty", Qnil
);
1919 p
->open_fd
[WRITE_TO_SUBPROCESS
] = forkout
;
1920 #if defined (DONT_REOPEN_PTY)
1921 /* In the case that vfork is defined as fork, the parent process
1922 (Emacs) may send some data before the child process completes
1923 tty options setup. So we setup tty before forking. */
1924 child_setup_tty (forkout
);
1925 #endif /* DONT_REOPEN_PTY */
1926 #endif /* not USG, or USG_SUBTTY_WORKS */
1928 fcntl (pty_fd
, F_SETFL
, O_NONBLOCK
);
1930 /* Record this as an active process, with its channels.
1931 As a result, child_setup will close Emacs's side of the pipes. */
1932 chan_process
[pty_fd
] = process
;
1936 /* Previously we recorded the tty descriptor used in the subprocess.
1937 It was only used for getting the foreground tty process, so now
1938 we just reopen the device (see emacs_get_tty_pgrp) as this is
1939 more portable (see USG_SUBTTY_WORKS above). */
1942 pset_status (p
, Qrun
);
1943 setup_process_coding_systems (process
);
1945 FD_SET (pty_fd
, &input_wait_mask
);
1946 FD_SET (pty_fd
, &non_keyboard_wait_mask
);
1947 if (pty_fd
> max_process_desc
)
1948 max_process_desc
= pty_fd
;
1950 pset_tty_name (p
, build_string (pty_name
));
1957 /* Convert an internal struct sockaddr to a lisp object (vector or string).
1958 The address family of sa is not included in the result. */
1964 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
1966 Lisp_Object address
;
1969 register struct Lisp_Vector
*p
;
1971 /* Workaround for a bug in getsockname on BSD: Names bound to
1972 sockets in the UNIX domain are inaccessible; getsockname returns
1973 a zero length name. */
1974 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
1975 return empty_unibyte_string
;
1977 switch (sa
->sa_family
)
1981 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
1982 len
= sizeof (sin
->sin_addr
) + 1;
1983 address
= Fmake_vector (make_number (len
), Qnil
);
1984 p
= XVECTOR (address
);
1985 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
1986 cp
= (unsigned char *) &sin
->sin_addr
;
1992 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
1993 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
1994 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
1995 address
= Fmake_vector (make_number (len
), Qnil
);
1996 p
= XVECTOR (address
);
1997 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
1998 for (i
= 0; i
< len
; i
++)
1999 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2003 #ifdef HAVE_LOCAL_SOCKETS
2006 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2007 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2008 if (sockun
->sun_path
[i
] == 0)
2010 return make_unibyte_string (sockun
->sun_path
, i
);
2014 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2015 address
= Fcons (make_number (sa
->sa_family
),
2016 Fmake_vector (make_number (len
), Qnil
));
2017 p
= XVECTOR (XCDR (address
));
2018 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2024 p
->contents
[i
++] = make_number (*cp
++);
2030 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2033 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2035 register struct Lisp_Vector
*p
;
2037 if (VECTORP (address
))
2039 p
= XVECTOR (address
);
2040 if (p
->header
.size
== 5)
2043 return sizeof (struct sockaddr_in
);
2046 else if (p
->header
.size
== 9)
2048 *familyp
= AF_INET6
;
2049 return sizeof (struct sockaddr_in6
);
2053 #ifdef HAVE_LOCAL_SOCKETS
2054 else if (STRINGP (address
))
2056 *familyp
= AF_LOCAL
;
2057 return sizeof (struct sockaddr_un
);
2060 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2061 && VECTORP (XCDR (address
)))
2063 struct sockaddr
*sa
;
2064 *familyp
= XINT (XCAR (address
));
2065 p
= XVECTOR (XCDR (address
));
2066 return p
->header
.size
+ sizeof (sa
->sa_family
);
2071 /* Convert an address object (vector or string) to an internal sockaddr.
2073 The address format has been basically validated by
2074 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2075 it could have come from user data. So if FAMILY is not valid,
2076 we return after zeroing *SA. */
2079 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2081 register struct Lisp_Vector
*p
;
2082 register unsigned char *cp
= NULL
;
2086 memset (sa
, 0, len
);
2088 if (VECTORP (address
))
2090 p
= XVECTOR (address
);
2091 if (family
== AF_INET
)
2093 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2094 len
= sizeof (sin
->sin_addr
) + 1;
2095 hostport
= XINT (p
->contents
[--len
]);
2096 sin
->sin_port
= htons (hostport
);
2097 cp
= (unsigned char *)&sin
->sin_addr
;
2098 sa
->sa_family
= family
;
2101 else if (family
== AF_INET6
)
2103 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2104 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2105 len
= sizeof (sin6
->sin6_addr
) + 1;
2106 hostport
= XINT (p
->contents
[--len
]);
2107 sin6
->sin6_port
= htons (hostport
);
2108 for (i
= 0; i
< len
; i
++)
2109 if (INTEGERP (p
->contents
[i
]))
2111 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2114 sa
->sa_family
= family
;
2121 else if (STRINGP (address
))
2123 #ifdef HAVE_LOCAL_SOCKETS
2124 if (family
== AF_LOCAL
)
2126 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2127 cp
= SDATA (address
);
2128 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2129 sockun
->sun_path
[i
] = *cp
++;
2130 sa
->sa_family
= family
;
2137 p
= XVECTOR (XCDR (address
));
2138 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2141 for (i
= 0; i
< len
; i
++)
2142 if (INTEGERP (p
->contents
[i
]))
2143 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2146 #ifdef DATAGRAM_SOCKETS
2147 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2149 doc
: /* Get the current datagram address associated with PROCESS. */)
2150 (Lisp_Object process
)
2154 CHECK_PROCESS (process
);
2156 if (!DATAGRAM_CONN_P (process
))
2159 channel
= XPROCESS (process
)->infd
;
2160 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2161 datagram_address
[channel
].len
);
2164 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2166 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2167 Returns nil upon error setting address, ADDRESS otherwise. */)
2168 (Lisp_Object process
, Lisp_Object address
)
2173 CHECK_PROCESS (process
);
2175 if (!DATAGRAM_CONN_P (process
))
2178 channel
= XPROCESS (process
)->infd
;
2180 len
= get_lisp_to_sockaddr_size (address
, &family
);
2181 if (len
== 0 || datagram_address
[channel
].len
!= len
)
2183 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2189 static const struct socket_options
{
2190 /* The name of this option. Should be lowercase version of option
2191 name without SO_ prefix. */
2193 /* Option level SOL_... */
2195 /* Option number SO_... */
2197 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2198 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2199 } socket_options
[] =
2201 #ifdef SO_BINDTODEVICE
2202 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2205 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2208 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2211 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2214 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2217 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2220 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2223 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2225 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2228 /* Set option OPT to value VAL on socket S.
2230 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2231 Signals an error if setting a known option fails.
2235 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2238 const struct socket_options
*sopt
;
2243 name
= SSDATA (SYMBOL_NAME (opt
));
2244 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2245 if (strcmp (name
, sopt
->name
) == 0)
2248 switch (sopt
->opttype
)
2253 optval
= NILP (val
) ? 0 : 1;
2254 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2255 &optval
, sizeof (optval
));
2262 if (TYPE_RANGED_INTEGERP (int, val
))
2263 optval
= XINT (val
);
2265 error ("Bad option value for %s", name
);
2266 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2267 &optval
, sizeof (optval
));
2271 #ifdef SO_BINDTODEVICE
2274 char devname
[IFNAMSIZ
+1];
2276 /* This is broken, at least in the Linux 2.4 kernel.
2277 To unbind, the arg must be a zero integer, not the empty string.
2278 This should work on all systems. KFS. 2003-09-23. */
2279 memset (devname
, 0, sizeof devname
);
2282 char *arg
= SSDATA (val
);
2283 int len
= min (strlen (arg
), IFNAMSIZ
);
2284 memcpy (devname
, arg
, len
);
2286 else if (!NILP (val
))
2287 error ("Bad option value for %s", name
);
2288 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2297 struct linger linger
;
2300 linger
.l_linger
= 0;
2301 if (TYPE_RANGED_INTEGERP (int, val
))
2302 linger
.l_linger
= XINT (val
);
2304 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2305 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2306 &linger
, sizeof (linger
));
2317 int setsockopt_errno
= errno
;
2318 report_file_errno ("Cannot set network option", list2 (opt
, val
),
2322 return (1 << sopt
->optbit
);
2326 DEFUN ("set-network-process-option",
2327 Fset_network_process_option
, Sset_network_process_option
,
2329 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2330 See `make-network-process' for a list of options and values.
2331 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2332 OPTION is not a supported option, return nil instead; otherwise return t. */)
2333 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2336 struct Lisp_Process
*p
;
2338 CHECK_PROCESS (process
);
2339 p
= XPROCESS (process
);
2340 if (!NETCONN1_P (p
))
2341 error ("Process is not a network process");
2345 error ("Process is not running");
2347 if (set_socket_option (s
, option
, value
))
2349 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2353 if (NILP (no_error
))
2354 error ("Unknown or unsupported option");
2360 DEFUN ("serial-process-configure",
2361 Fserial_process_configure
,
2362 Sserial_process_configure
,
2364 doc
: /* Configure speed, bytesize, etc. of a serial process.
2366 Arguments are specified as keyword/argument pairs. Attributes that
2367 are not given are re-initialized from the process's current
2368 configuration (available via the function `process-contact') or set to
2369 reasonable default values. The following arguments are defined:
2375 -- Any of these arguments can be given to identify the process that is
2376 to be configured. If none of these arguments is given, the current
2377 buffer's process is used.
2379 :speed SPEED -- SPEED is the speed of the serial port in bits per
2380 second, also called baud rate. Any value can be given for SPEED, but
2381 most serial ports work only at a few defined values between 1200 and
2382 115200, with 9600 being the most common value. If SPEED is nil, the
2383 serial port is not configured any further, i.e., all other arguments
2384 are ignored. This may be useful for special serial ports such as
2385 Bluetooth-to-serial converters which can only be configured through AT
2386 commands. A value of nil for SPEED can be used only when passed
2387 through `make-serial-process' or `serial-term'.
2389 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2390 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2392 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2393 `odd' (use odd parity), or the symbol `even' (use even parity). If
2394 PARITY is not given, no parity is used.
2396 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2397 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2398 is not given or nil, 1 stopbit is used.
2400 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2401 flowcontrol to be used, which is either nil (don't use flowcontrol),
2402 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2403 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2404 flowcontrol is used.
2406 `serial-process-configure' is called by `make-serial-process' for the
2407 initial configuration of the serial port.
2411 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2413 \(serial-process-configure
2414 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2416 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2418 usage: (serial-process-configure &rest ARGS) */)
2419 (ptrdiff_t nargs
, Lisp_Object
*args
)
2421 struct Lisp_Process
*p
;
2422 Lisp_Object contact
= Qnil
;
2423 Lisp_Object proc
= Qnil
;
2424 struct gcpro gcpro1
;
2426 contact
= Flist (nargs
, args
);
2429 proc
= Fplist_get (contact
, QCprocess
);
2431 proc
= Fplist_get (contact
, QCname
);
2433 proc
= Fplist_get (contact
, QCbuffer
);
2435 proc
= Fplist_get (contact
, QCport
);
2436 proc
= get_process (proc
);
2437 p
= XPROCESS (proc
);
2438 if (!EQ (p
->type
, Qserial
))
2439 error ("Not a serial process");
2441 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2447 serial_configure (p
, contact
);
2453 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2455 doc
: /* Create and return a serial port process.
2457 In Emacs, serial port connections are represented by process objects,
2458 so input and output work as for subprocesses, and `delete-process'
2459 closes a serial port connection. However, a serial process has no
2460 process id, it cannot be signaled, and the status codes are different
2461 from normal processes.
2463 `make-serial-process' creates a process and a buffer, on which you
2464 probably want to use `process-send-string'. Try \\[serial-term] for
2465 an interactive terminal. See below for examples.
2467 Arguments are specified as keyword/argument pairs. The following
2468 arguments are defined:
2470 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2471 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2472 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2473 the backslashes in strings).
2475 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2476 which this function calls.
2478 :name NAME -- NAME is the name of the process. If NAME is not given,
2479 the value of PORT is used.
2481 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2482 with the process. Process output goes at the end of that buffer,
2483 unless you specify an output stream or filter function to handle the
2484 output. If BUFFER is not given, the value of NAME is used.
2486 :coding CODING -- If CODING is a symbol, it specifies the coding
2487 system used for both reading and writing for this process. If CODING
2488 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2489 ENCODING is used for writing.
2491 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2492 the process is running. If BOOL is not given, query before exiting.
2494 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2495 In the stopped state, a serial process does not accept incoming data,
2496 but you can send outgoing data. The stopped state is cleared by
2497 `continue-process' and set by `stop-process'.
2499 :filter FILTER -- Install FILTER as the process filter.
2501 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2503 :plist PLIST -- Install PLIST as the initial plist of the process.
2509 -- This function calls `serial-process-configure' to handle these
2512 The original argument list, possibly modified by later configuration,
2513 is available via the function `process-contact'.
2517 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2519 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2521 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2523 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2525 usage: (make-serial-process &rest ARGS) */)
2526 (ptrdiff_t nargs
, Lisp_Object
*args
)
2529 Lisp_Object proc
, contact
, port
;
2530 struct Lisp_Process
*p
;
2531 struct gcpro gcpro1
;
2532 Lisp_Object name
, buffer
;
2533 Lisp_Object tem
, val
;
2534 ptrdiff_t specpdl_count
;
2539 contact
= Flist (nargs
, args
);
2542 port
= Fplist_get (contact
, QCport
);
2544 error ("No port specified");
2545 CHECK_STRING (port
);
2547 if (NILP (Fplist_member (contact
, QCspeed
)))
2548 error (":speed not specified");
2549 if (!NILP (Fplist_get (contact
, QCspeed
)))
2550 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2552 name
= Fplist_get (contact
, QCname
);
2555 CHECK_STRING (name
);
2556 proc
= make_process (name
);
2557 specpdl_count
= SPECPDL_INDEX ();
2558 record_unwind_protect (remove_process
, proc
);
2559 p
= XPROCESS (proc
);
2561 fd
= serial_open (port
);
2562 p
->open_fd
[SUBPROCESS_STDIN
] = fd
;
2565 if (fd
> max_process_desc
)
2566 max_process_desc
= fd
;
2567 chan_process
[fd
] = proc
;
2569 buffer
= Fplist_get (contact
, QCbuffer
);
2572 buffer
= Fget_buffer_create (buffer
);
2573 pset_buffer (p
, buffer
);
2575 pset_childp (p
, contact
);
2576 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2577 pset_type (p
, Qserial
);
2578 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2579 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2581 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2582 p
->kill_without_query
= 1;
2583 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2584 pset_command (p
, Qt
);
2585 eassert (! p
->pty_flag
);
2587 if (!EQ (p
->command
, Qt
))
2589 FD_SET (fd
, &input_wait_mask
);
2590 FD_SET (fd
, &non_keyboard_wait_mask
);
2593 if (BUFFERP (buffer
))
2595 set_marker_both (p
->mark
, buffer
,
2596 BUF_ZV (XBUFFER (buffer
)),
2597 BUF_ZV_BYTE (XBUFFER (buffer
)));
2600 tem
= Fplist_member (contact
, QCcoding
);
2601 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2607 val
= XCAR (XCDR (tem
));
2611 else if (!NILP (Vcoding_system_for_read
))
2612 val
= Vcoding_system_for_read
;
2613 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2614 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2616 pset_decode_coding_system (p
, val
);
2621 val
= XCAR (XCDR (tem
));
2625 else if (!NILP (Vcoding_system_for_write
))
2626 val
= Vcoding_system_for_write
;
2627 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2628 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2630 pset_encode_coding_system (p
, val
);
2632 setup_process_coding_systems (proc
);
2633 pset_decoding_buf (p
, empty_unibyte_string
);
2634 p
->decoding_carryover
= 0;
2635 pset_encoding_buf (p
, empty_unibyte_string
);
2636 p
->inherit_coding_system_flag
2637 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2639 Fserial_process_configure (nargs
, args
);
2641 specpdl_ptr
= specpdl
+ specpdl_count
;
2647 /* Create a network stream/datagram client/server process. Treated
2648 exactly like a normal process when reading and writing. Primary
2649 differences are in status display and process deletion. A network
2650 connection has no PID; you cannot signal it. All you can do is
2651 stop/continue it and deactivate/close it via delete-process */
2653 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2655 doc
: /* Create and return a network server or client process.
2657 In Emacs, network connections are represented by process objects, so
2658 input and output work as for subprocesses and `delete-process' closes
2659 a network connection. However, a network process has no process id,
2660 it cannot be signaled, and the status codes are different from normal
2663 Arguments are specified as keyword/argument pairs. The following
2664 arguments are defined:
2666 :name NAME -- NAME is name for process. It is modified if necessary
2669 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2670 with the process. Process output goes at end of that buffer, unless
2671 you specify an output stream or filter function to handle the output.
2672 BUFFER may be also nil, meaning that this process is not associated
2675 :host HOST -- HOST is name of the host to connect to, or its IP
2676 address. The symbol `local' specifies the local host. If specified
2677 for a server process, it must be a valid name or address for the local
2678 host, and only clients connecting to that address will be accepted.
2680 :service SERVICE -- SERVICE is name of the service desired, or an
2681 integer specifying a port number to connect to. If SERVICE is t,
2682 a random port number is selected for the server. (If Emacs was
2683 compiled with getaddrinfo, a port number can also be specified as a
2684 string, e.g. "80", as well as an integer. This is not portable.)
2686 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2687 stream type connection, `datagram' creates a datagram type connection,
2688 `seqpacket' creates a reliable datagram connection.
2690 :family FAMILY -- FAMILY is the address (and protocol) family for the
2691 service specified by HOST and SERVICE. The default (nil) is to use
2692 whatever address family (IPv4 or IPv6) that is defined for the host
2693 and port number specified by HOST and SERVICE. Other address families
2695 local -- for a local (i.e. UNIX) address specified by SERVICE.
2696 ipv4 -- use IPv4 address family only.
2697 ipv6 -- use IPv6 address family only.
2699 :local ADDRESS -- ADDRESS is the local address used for the connection.
2700 This parameter is ignored when opening a client process. When specified
2701 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2703 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2704 connection. This parameter is ignored when opening a stream server
2705 process. For a datagram server process, it specifies the initial
2706 setting of the remote datagram address. When specified for a client
2707 process, the FAMILY, HOST, and SERVICE args are ignored.
2709 The format of ADDRESS depends on the address family:
2710 - An IPv4 address is represented as an vector of integers [A B C D P]
2711 corresponding to numeric IP address A.B.C.D and port number P.
2712 - A local address is represented as a string with the address in the
2713 local address space.
2714 - An "unsupported family" address is represented by a cons (F . AV)
2715 where F is the family number and AV is a vector containing the socket
2716 address data with one element per address data byte. Do not rely on
2717 this format in portable code, as it may depend on implementation
2718 defined constants, data sizes, and data structure alignment.
2720 :coding CODING -- If CODING is a symbol, it specifies the coding
2721 system used for both reading and writing for this process. If CODING
2722 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2723 ENCODING is used for writing.
2725 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2726 return without waiting for the connection to complete; instead, the
2727 sentinel function will be called with second arg matching "open" (if
2728 successful) or "failed" when the connect completes. Default is to use
2729 a blocking connect (i.e. wait) for stream type connections.
2731 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2732 running when Emacs is exited.
2734 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2735 In the stopped state, a server process does not accept new
2736 connections, and a client process does not handle incoming traffic.
2737 The stopped state is cleared by `continue-process' and set by
2740 :filter FILTER -- Install FILTER as the process filter.
2742 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2743 process filter are multibyte, otherwise they are unibyte.
2744 If this keyword is not specified, the strings are multibyte if
2745 the default value of `enable-multibyte-characters' is non-nil.
2747 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2749 :log LOG -- Install LOG as the server process log function. This
2750 function is called when the server accepts a network connection from a
2751 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2752 is the server process, CLIENT is the new process for the connection,
2753 and MESSAGE is a string.
2755 :plist PLIST -- Install PLIST as the new process' initial plist.
2757 :server QLEN -- if QLEN is non-nil, create a server process for the
2758 specified FAMILY, SERVICE, and connection type (stream or datagram).
2759 If QLEN is an integer, it is used as the max. length of the server's
2760 pending connection queue (also known as the backlog); the default
2761 queue length is 5. Default is to create a client process.
2763 The following network options can be specified for this connection:
2765 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2766 :dontroute BOOL -- Only send to directly connected hosts.
2767 :keepalive BOOL -- Send keep-alive messages on network stream.
2768 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2769 :oobinline BOOL -- Place out-of-band data in receive data stream.
2770 :priority INT -- Set protocol defined priority for sent packets.
2771 :reuseaddr BOOL -- Allow reusing a recently used local address
2772 (this is allowed by default for a server process).
2773 :bindtodevice NAME -- bind to interface NAME. Using this may require
2774 special privileges on some systems.
2776 Consult the relevant system programmer's manual pages for more
2777 information on using these options.
2780 A server process will listen for and accept connections from clients.
2781 When a client connection is accepted, a new network process is created
2782 for the connection with the following parameters:
2784 - The client's process name is constructed by concatenating the server
2785 process' NAME and a client identification string.
2786 - If the FILTER argument is non-nil, the client process will not get a
2787 separate process buffer; otherwise, the client's process buffer is a newly
2788 created buffer named after the server process' BUFFER name or process
2789 NAME concatenated with the client identification string.
2790 - The connection type and the process filter and sentinel parameters are
2791 inherited from the server process' TYPE, FILTER and SENTINEL.
2792 - The client process' contact info is set according to the client's
2793 addressing information (typically an IP address and a port number).
2794 - The client process' plist is initialized from the server's plist.
2796 Notice that the FILTER and SENTINEL args are never used directly by
2797 the server process. Also, the BUFFER argument is not used directly by
2798 the server process, but via the optional :log function, accepted (and
2799 failed) connections may be logged in the server process' buffer.
2801 The original argument list, modified with the actual connection
2802 information, is available via the `process-contact' function.
2804 usage: (make-network-process &rest ARGS) */)
2805 (ptrdiff_t nargs
, Lisp_Object
*args
)
2808 Lisp_Object contact
;
2809 struct Lisp_Process
*p
;
2810 #ifdef HAVE_GETADDRINFO
2811 struct addrinfo ai
, *res
, *lres
;
2812 struct addrinfo hints
;
2813 const char *portstring
;
2815 #else /* HAVE_GETADDRINFO */
2816 struct _emacs_addrinfo
2822 struct sockaddr
*ai_addr
;
2823 struct _emacs_addrinfo
*ai_next
;
2825 #endif /* HAVE_GETADDRINFO */
2826 struct sockaddr_in address_in
;
2827 #ifdef HAVE_LOCAL_SOCKETS
2828 struct sockaddr_un address_un
;
2833 int s
= -1, outch
, inch
;
2834 struct gcpro gcpro1
;
2835 ptrdiff_t count
= SPECPDL_INDEX ();
2837 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2839 Lisp_Object name
, buffer
, host
, service
, address
;
2840 Lisp_Object filter
, sentinel
;
2841 bool is_non_blocking_client
= 0;
2850 /* Save arguments for process-contact and clone-process. */
2851 contact
= Flist (nargs
, args
);
2855 /* Ensure socket support is loaded if available. */
2856 init_winsock (TRUE
);
2859 /* :type TYPE (nil: stream, datagram */
2860 tem
= Fplist_get (contact
, QCtype
);
2862 socktype
= SOCK_STREAM
;
2863 #ifdef DATAGRAM_SOCKETS
2864 else if (EQ (tem
, Qdatagram
))
2865 socktype
= SOCK_DGRAM
;
2867 #ifdef HAVE_SEQPACKET
2868 else if (EQ (tem
, Qseqpacket
))
2869 socktype
= SOCK_SEQPACKET
;
2872 error ("Unsupported connection type");
2875 tem
= Fplist_get (contact
, QCserver
);
2878 /* Don't support network sockets when non-blocking mode is
2879 not available, since a blocked Emacs is not useful. */
2881 if (TYPE_RANGED_INTEGERP (int, tem
))
2882 backlog
= XINT (tem
);
2885 /* Make QCaddress an alias for :local (server) or :remote (client). */
2886 QCaddress
= is_server
? QClocal
: QCremote
;
2889 if (!is_server
&& socktype
!= SOCK_DGRAM
2890 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2892 #ifndef NON_BLOCKING_CONNECT
2893 error ("Non-blocking connect not supported");
2895 is_non_blocking_client
= 1;
2899 name
= Fplist_get (contact
, QCname
);
2900 buffer
= Fplist_get (contact
, QCbuffer
);
2901 filter
= Fplist_get (contact
, QCfilter
);
2902 sentinel
= Fplist_get (contact
, QCsentinel
);
2904 CHECK_STRING (name
);
2906 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2907 ai
.ai_socktype
= socktype
;
2912 /* :local ADDRESS or :remote ADDRESS */
2913 address
= Fplist_get (contact
, QCaddress
);
2914 if (!NILP (address
))
2916 host
= service
= Qnil
;
2918 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2919 error ("Malformed :address");
2920 ai
.ai_family
= family
;
2921 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2922 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2926 /* :family FAMILY -- nil (for Inet), local, or integer. */
2927 tem
= Fplist_get (contact
, QCfamily
);
2930 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
2936 #ifdef HAVE_LOCAL_SOCKETS
2937 else if (EQ (tem
, Qlocal
))
2941 else if (EQ (tem
, Qipv6
))
2944 else if (EQ (tem
, Qipv4
))
2946 else if (TYPE_RANGED_INTEGERP (int, tem
))
2947 family
= XINT (tem
);
2949 error ("Unknown address family");
2951 ai
.ai_family
= family
;
2953 /* :service SERVICE -- string, integer (port number), or t (random port). */
2954 service
= Fplist_get (contact
, QCservice
);
2956 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2957 host
= Fplist_get (contact
, QChost
);
2960 if (EQ (host
, Qlocal
))
2961 /* Depending on setup, "localhost" may map to different IPv4 and/or
2962 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
2963 host
= build_string ("127.0.0.1");
2964 CHECK_STRING (host
);
2967 #ifdef HAVE_LOCAL_SOCKETS
2968 if (family
== AF_LOCAL
)
2972 message (":family local ignores the :host \"%s\" property",
2974 contact
= Fplist_put (contact
, QChost
, Qnil
);
2977 CHECK_STRING (service
);
2978 memset (&address_un
, 0, sizeof address_un
);
2979 address_un
.sun_family
= AF_LOCAL
;
2980 if (sizeof address_un
.sun_path
<= SBYTES (service
))
2981 error ("Service name too long");
2982 strcpy (address_un
.sun_path
, SSDATA (service
));
2983 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2984 ai
.ai_addrlen
= sizeof address_un
;
2989 /* Slow down polling to every ten seconds.
2990 Some kernels have a bug which causes retrying connect to fail
2991 after a connect. Polling can interfere with gethostbyname too. */
2992 #ifdef POLL_FOR_INPUT
2993 if (socktype
!= SOCK_DGRAM
)
2995 record_unwind_protect_void (run_all_atimers
);
2996 bind_polling_period (10);
3000 #ifdef HAVE_GETADDRINFO
3001 /* If we have a host, use getaddrinfo to resolve both host and service.
3002 Otherwise, use getservbyname to lookup the service. */
3006 /* SERVICE can either be a string or int.
3007 Convert to a C string for later use by getaddrinfo. */
3008 if (EQ (service
, Qt
))
3010 else if (INTEGERP (service
))
3012 sprintf (portbuf
, "%"pI
"d", XINT (service
));
3013 portstring
= portbuf
;
3017 CHECK_STRING (service
);
3018 portstring
= SSDATA (service
);
3023 memset (&hints
, 0, sizeof (hints
));
3025 hints
.ai_family
= family
;
3026 hints
.ai_socktype
= socktype
;
3027 hints
.ai_protocol
= 0;
3029 #ifdef HAVE_RES_INIT
3033 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
3035 #ifdef HAVE_GAI_STRERROR
3036 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3038 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3044 #endif /* HAVE_GETADDRINFO */
3046 /* We end up here if getaddrinfo is not defined, or in case no hostname
3047 has been specified (e.g. for a local server process). */
3049 if (EQ (service
, Qt
))
3051 else if (INTEGERP (service
))
3052 port
= htons ((unsigned short) XINT (service
));
3055 struct servent
*svc_info
;
3056 CHECK_STRING (service
);
3057 svc_info
= getservbyname (SSDATA (service
),
3058 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3060 error ("Unknown service: %s", SDATA (service
));
3061 port
= svc_info
->s_port
;
3064 memset (&address_in
, 0, sizeof address_in
);
3065 address_in
.sin_family
= family
;
3066 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3067 address_in
.sin_port
= port
;
3069 #ifndef HAVE_GETADDRINFO
3072 struct hostent
*host_info_ptr
;
3074 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3075 as it may `hang' Emacs for a very long time. */
3079 #ifdef HAVE_RES_INIT
3083 host_info_ptr
= gethostbyname (SDATA (host
));
3088 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3089 host_info_ptr
->h_length
);
3090 family
= host_info_ptr
->h_addrtype
;
3091 address_in
.sin_family
= family
;
3094 /* Attempt to interpret host as numeric inet address */
3096 unsigned long numeric_addr
;
3097 numeric_addr
= inet_addr (SSDATA (host
));
3098 if (numeric_addr
== -1)
3099 error ("Unknown host \"%s\"", SDATA (host
));
3101 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3102 sizeof (address_in
.sin_addr
));
3106 #endif /* not HAVE_GETADDRINFO */
3108 ai
.ai_family
= family
;
3109 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3110 ai
.ai_addrlen
= sizeof address_in
;
3114 /* Do this in case we never enter the for-loop below. */
3115 count1
= SPECPDL_INDEX ();
3118 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3127 s
= socket (lres
->ai_family
, lres
->ai_socktype
| SOCK_CLOEXEC
,
3135 #ifdef DATAGRAM_SOCKETS
3136 if (!is_server
&& socktype
== SOCK_DGRAM
)
3138 #endif /* DATAGRAM_SOCKETS */
3140 #ifdef NON_BLOCKING_CONNECT
3141 if (is_non_blocking_client
)
3143 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3154 /* Make us close S if quit. */
3155 record_unwind_protect_int (close_file_unwind
, s
);
3157 /* Parse network options in the arg list.
3158 We simply ignore anything which isn't a known option (including other keywords).
3159 An error is signaled if setting a known option fails. */
3160 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3161 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3165 /* Configure as a server socket. */
3167 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3168 explicit :reuseaddr key to override this. */
3169 #ifdef HAVE_LOCAL_SOCKETS
3170 if (family
!= AF_LOCAL
)
3172 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3175 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3176 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3179 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3180 report_file_error ("Cannot bind server socket", Qnil
);
3182 #ifdef HAVE_GETSOCKNAME
3183 if (EQ (service
, Qt
))
3185 struct sockaddr_in sa1
;
3186 socklen_t len1
= sizeof (sa1
);
3187 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3189 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3190 service
= make_number (ntohs (sa1
.sin_port
));
3191 contact
= Fplist_put (contact
, QCservice
, service
);
3196 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3197 report_file_error ("Cannot listen on server socket", Qnil
);
3205 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3208 if (ret
== 0 || xerrno
== EISCONN
)
3210 /* The unwind-protect will be discarded afterwards.
3211 Likewise for immediate_quit. */
3215 #ifdef NON_BLOCKING_CONNECT
3217 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3221 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3228 if (xerrno
== EINTR
)
3230 /* Unlike most other syscalls connect() cannot be called
3231 again. (That would return EALREADY.) The proper way to
3232 wait for completion is pselect(). */
3240 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3246 report_file_error ("Failed select", Qnil
);
3250 len
= sizeof xerrno
;
3251 eassert (FD_ISSET (s
, &fdset
));
3252 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) < 0)
3253 report_file_error ("Failed getsockopt", Qnil
);
3255 report_file_errno ("Failed connect", Qnil
, xerrno
);
3258 #endif /* !WINDOWSNT */
3262 /* Discard the unwind protect closing S. */
3263 specpdl_ptr
= specpdl
+ count1
;
3268 if (xerrno
== EINTR
)
3275 #ifdef DATAGRAM_SOCKETS
3276 if (socktype
== SOCK_DGRAM
)
3278 if (datagram_address
[s
].sa
)
3280 datagram_address
[s
].sa
= xmalloc (lres
->ai_addrlen
);
3281 datagram_address
[s
].len
= lres
->ai_addrlen
;
3285 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3286 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3289 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3290 if (rlen
!= 0 && rfamily
== lres
->ai_family
3291 && rlen
== lres
->ai_addrlen
)
3292 conv_lisp_to_sockaddr (rfamily
, remote
,
3293 datagram_address
[s
].sa
, rlen
);
3297 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3300 contact
= Fplist_put (contact
, QCaddress
,
3301 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3302 #ifdef HAVE_GETSOCKNAME
3305 struct sockaddr_in sa1
;
3306 socklen_t len1
= sizeof (sa1
);
3307 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3308 contact
= Fplist_put (contact
, QClocal
,
3309 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3316 #ifdef HAVE_GETADDRINFO
3327 /* If non-blocking got this far - and failed - assume non-blocking is
3328 not supported after all. This is probably a wrong assumption, but
3329 the normal blocking calls to open-network-stream handles this error
3331 if (is_non_blocking_client
)
3334 report_file_errno ((is_server
3335 ? "make server process failed"
3336 : "make client process failed"),
3344 buffer
= Fget_buffer_create (buffer
);
3345 proc
= make_process (name
);
3347 chan_process
[inch
] = proc
;
3349 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3351 p
= XPROCESS (proc
);
3353 pset_childp (p
, contact
);
3354 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3355 pset_type (p
, Qnetwork
);
3357 pset_buffer (p
, buffer
);
3358 pset_sentinel (p
, sentinel
);
3359 pset_filter (p
, filter
);
3360 pset_log (p
, Fplist_get (contact
, QClog
));
3361 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3362 p
->kill_without_query
= 1;
3363 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3364 pset_command (p
, Qt
);
3367 p
->open_fd
[SUBPROCESS_STDIN
] = inch
;
3371 /* Discard the unwind protect for closing S, if any. */
3372 specpdl_ptr
= specpdl
+ count1
;
3374 /* Unwind bind_polling_period and request_sigio. */
3375 unbind_to (count
, Qnil
);
3377 if (is_server
&& socktype
!= SOCK_DGRAM
)
3378 pset_status (p
, Qlisten
);
3380 /* Make the process marker point into the process buffer (if any). */
3381 if (BUFFERP (buffer
))
3382 set_marker_both (p
->mark
, buffer
,
3383 BUF_ZV (XBUFFER (buffer
)),
3384 BUF_ZV_BYTE (XBUFFER (buffer
)));
3386 #ifdef NON_BLOCKING_CONNECT
3387 if (is_non_blocking_client
)
3389 /* We may get here if connect did succeed immediately. However,
3390 in that case, we still need to signal this like a non-blocking
3392 pset_status (p
, Qconnect
);
3393 if (!FD_ISSET (inch
, &connect_wait_mask
))
3395 FD_SET (inch
, &connect_wait_mask
);
3396 FD_SET (inch
, &write_mask
);
3397 num_pending_connects
++;
3402 /* A server may have a client filter setting of Qt, but it must
3403 still listen for incoming connects unless it is stopped. */
3404 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3405 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3407 FD_SET (inch
, &input_wait_mask
);
3408 FD_SET (inch
, &non_keyboard_wait_mask
);
3411 if (inch
> max_process_desc
)
3412 max_process_desc
= inch
;
3414 tem
= Fplist_member (contact
, QCcoding
);
3415 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3416 tem
= Qnil
; /* No error message (too late!). */
3419 /* Setup coding systems for communicating with the network stream. */
3420 struct gcpro gcpro1
;
3421 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3422 Lisp_Object coding_systems
= Qt
;
3423 Lisp_Object fargs
[5], val
;
3427 val
= XCAR (XCDR (tem
));
3431 else if (!NILP (Vcoding_system_for_read
))
3432 val
= Vcoding_system_for_read
;
3433 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3434 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3435 /* We dare not decode end-of-line format by setting VAL to
3436 Qraw_text, because the existing Emacs Lisp libraries
3437 assume that they receive bare code including a sequence of
3442 if (NILP (host
) || NILP (service
))
3443 coding_systems
= Qnil
;
3446 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3447 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3449 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3452 if (CONSP (coding_systems
))
3453 val
= XCAR (coding_systems
);
3454 else if (CONSP (Vdefault_process_coding_system
))
3455 val
= XCAR (Vdefault_process_coding_system
);
3459 pset_decode_coding_system (p
, val
);
3463 val
= XCAR (XCDR (tem
));
3467 else if (!NILP (Vcoding_system_for_write
))
3468 val
= Vcoding_system_for_write
;
3469 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3473 if (EQ (coding_systems
, Qt
))
3475 if (NILP (host
) || NILP (service
))
3476 coding_systems
= Qnil
;
3479 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3480 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3482 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3486 if (CONSP (coding_systems
))
3487 val
= XCDR (coding_systems
);
3488 else if (CONSP (Vdefault_process_coding_system
))
3489 val
= XCDR (Vdefault_process_coding_system
);
3493 pset_encode_coding_system (p
, val
);
3495 setup_process_coding_systems (proc
);
3497 pset_decoding_buf (p
, empty_unibyte_string
);
3498 p
->decoding_carryover
= 0;
3499 pset_encoding_buf (p
, empty_unibyte_string
);
3501 p
->inherit_coding_system_flag
3502 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3509 #ifdef HAVE_NET_IF_H
3513 network_interface_list (void)
3515 struct ifconf ifconf
;
3516 struct ifreq
*ifreq
;
3518 ptrdiff_t buf_size
= 512;
3523 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
3526 count
= SPECPDL_INDEX ();
3527 record_unwind_protect_int (close_file_unwind
, s
);
3531 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
3532 ifconf
.ifc_buf
= buf
;
3533 ifconf
.ifc_len
= buf_size
;
3534 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3541 while (ifconf
.ifc_len
== buf_size
);
3543 res
= unbind_to (count
, Qnil
);
3544 ifreq
= ifconf
.ifc_req
;
3545 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
3547 struct ifreq
*ifq
= ifreq
;
3548 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3549 #define SIZEOF_IFREQ(sif) \
3550 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3551 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3553 int len
= SIZEOF_IFREQ (ifq
);
3555 int len
= sizeof (*ifreq
);
3557 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3558 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
3560 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3563 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3564 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3565 res
= Fcons (Fcons (build_string (namebuf
),
3566 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3567 sizeof (struct sockaddr
))),
3574 #endif /* SIOCGIFCONF */
3576 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
3580 const char *flag_sym
;
3583 static const struct ifflag_def ifflag_table
[] = {
3587 #ifdef IFF_BROADCAST
3588 { IFF_BROADCAST
, "broadcast" },
3591 { IFF_DEBUG
, "debug" },
3594 { IFF_LOOPBACK
, "loopback" },
3596 #ifdef IFF_POINTOPOINT
3597 { IFF_POINTOPOINT
, "pointopoint" },
3600 { IFF_RUNNING
, "running" },
3603 { IFF_NOARP
, "noarp" },
3606 { IFF_PROMISC
, "promisc" },
3608 #ifdef IFF_NOTRAILERS
3609 #ifdef NS_IMPL_COCOA
3610 /* Really means smart, notrailers is obsolete */
3611 { IFF_NOTRAILERS
, "smart" },
3613 { IFF_NOTRAILERS
, "notrailers" },
3617 { IFF_ALLMULTI
, "allmulti" },
3620 { IFF_MASTER
, "master" },
3623 { IFF_SLAVE
, "slave" },
3625 #ifdef IFF_MULTICAST
3626 { IFF_MULTICAST
, "multicast" },
3629 { IFF_PORTSEL
, "portsel" },
3631 #ifdef IFF_AUTOMEDIA
3632 { IFF_AUTOMEDIA
, "automedia" },
3635 { IFF_DYNAMIC
, "dynamic" },
3638 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3641 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3644 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3647 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3650 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3656 network_interface_info (Lisp_Object ifname
)
3659 Lisp_Object res
= Qnil
;
3664 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3665 && defined HAVE_GETIFADDRS && defined LLADDR)
3666 struct ifaddrs
*ifap
;
3669 CHECK_STRING (ifname
);
3671 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
3672 error ("interface name too long");
3673 strcpy (rq
.ifr_name
, SSDATA (ifname
));
3675 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
3678 count
= SPECPDL_INDEX ();
3679 record_unwind_protect_int (close_file_unwind
, s
);
3682 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
3683 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3685 int flags
= rq
.ifr_flags
;
3686 const struct ifflag_def
*fp
;
3689 /* If flags is smaller than int (i.e. short) it may have the high bit set
3690 due to IFF_MULTICAST. In that case, sign extending it into
3692 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
3693 flags
= (unsigned short) rq
.ifr_flags
;
3696 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3698 if (flags
& fp
->flag_bit
)
3700 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3701 flags
-= fp
->flag_bit
;
3704 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
3708 elt
= Fcons (make_number (fnum
), elt
);
3713 res
= Fcons (elt
, res
);
3716 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
3717 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3719 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3720 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3724 for (n
= 0; n
< 6; n
++)
3725 p
->contents
[n
] = make_number (((unsigned char *)
3726 &rq
.ifr_hwaddr
.sa_data
[0])
3728 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3730 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
3731 if (getifaddrs (&ifap
) != -1)
3733 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3734 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3737 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
3739 struct sockaddr_dl
*sdl
= (struct sockaddr_dl
*) it
->ifa_addr
;
3740 unsigned char linkaddr
[6];
3743 if (it
->ifa_addr
->sa_family
!= AF_LINK
3744 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
3745 || sdl
->sdl_alen
!= 6)
3748 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
3749 for (n
= 0; n
< 6; n
++)
3750 p
->contents
[n
] = make_number (linkaddr
[n
]);
3752 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
3756 #ifdef HAVE_FREEIFADDRS
3760 #endif /* HAVE_GETIFADDRS && LLADDR */
3762 res
= Fcons (elt
, res
);
3765 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
3766 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3769 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3770 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3772 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3776 res
= Fcons (elt
, res
);
3779 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3780 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3783 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3786 res
= Fcons (elt
, res
);
3789 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
3790 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3793 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3796 res
= Fcons (elt
, res
);
3798 return unbind_to (count
, any
? res
: Qnil
);
3800 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
3801 #endif /* defined (HAVE_NET_IF_H) */
3803 DEFUN ("network-interface-list", Fnetwork_interface_list
,
3804 Snetwork_interface_list
, 0, 0, 0,
3805 doc
: /* Return an alist of all network interfaces and their network address.
3806 Each element is a cons, the car of which is a string containing the
3807 interface name, and the cdr is the network address in internal
3808 format; see the description of ADDRESS in `make-network-process'.
3810 If the information is not available, return nil. */)
3813 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
3814 return network_interface_list ();
3820 DEFUN ("network-interface-info", Fnetwork_interface_info
,
3821 Snetwork_interface_info
, 1, 1, 0,
3822 doc
: /* Return information about network interface named IFNAME.
3823 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3824 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3825 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
3826 FLAGS is the current flags of the interface.
3828 Data that is unavailable is returned as nil. */)
3829 (Lisp_Object ifname
)
3831 #if ((defined HAVE_NET_IF_H \
3832 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
3833 || defined SIOCGIFFLAGS)) \
3834 || defined WINDOWSNT)
3835 return network_interface_info (ifname
);
3842 /* Turn off input and output for process PROC. */
3845 deactivate_process (Lisp_Object proc
)
3848 struct Lisp_Process
*p
= XPROCESS (proc
);
3852 /* Delete GnuTLS structures in PROC, if any. */
3853 emacs_gnutls_deinit (proc
);
3854 #endif /* HAVE_GNUTLS */
3856 #ifdef ADAPTIVE_READ_BUFFERING
3857 if (p
->read_output_delay
> 0)
3859 if (--process_output_delay_count
< 0)
3860 process_output_delay_count
= 0;
3861 p
->read_output_delay
= 0;
3862 p
->read_output_skip
= 0;
3866 /* Beware SIGCHLD hereabouts. */
3868 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
3869 close_process_fd (&p
->open_fd
[i
]);
3871 inchannel
= p
->infd
;
3876 #ifdef DATAGRAM_SOCKETS
3877 if (DATAGRAM_CHAN_P (inchannel
))
3879 xfree (datagram_address
[inchannel
].sa
);
3880 datagram_address
[inchannel
].sa
= 0;
3881 datagram_address
[inchannel
].len
= 0;
3884 chan_process
[inchannel
] = Qnil
;
3885 FD_CLR (inchannel
, &input_wait_mask
);
3886 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3887 #ifdef NON_BLOCKING_CONNECT
3888 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3890 FD_CLR (inchannel
, &connect_wait_mask
);
3891 FD_CLR (inchannel
, &write_mask
);
3892 if (--num_pending_connects
< 0)
3896 if (inchannel
== max_process_desc
)
3898 /* We just closed the highest-numbered process input descriptor,
3899 so recompute the highest-numbered one now. */
3903 while (0 <= i
&& NILP (chan_process
[i
]));
3905 max_process_desc
= i
;
3911 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3913 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3914 It is read into the process' buffers or given to their filter functions.
3915 Non-nil arg PROCESS means do not return until some output has been received
3918 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3919 and milliseconds to wait; return after that much time whether or not
3920 there is any subprocess output. If SECONDS is a floating point number,
3921 it specifies a fractional number of seconds to wait.
3922 The MILLISEC argument is obsolete and should be avoided.
3924 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3925 from PROCESS, suspending reading output from other processes.
3926 If JUST-THIS-ONE is an integer, don't run any timers either.
3927 Return non-nil if we received any output before the timeout expired. */)
3928 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
3933 if (! NILP (process
))
3934 CHECK_PROCESS (process
);
3936 just_this_one
= Qnil
;
3938 if (!NILP (millisec
))
3939 { /* Obsolete calling convention using integers rather than floats. */
3940 CHECK_NUMBER (millisec
);
3942 seconds
= make_float (XINT (millisec
) / 1000.0);
3945 CHECK_NUMBER (seconds
);
3946 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
3953 if (!NILP (seconds
))
3955 if (INTEGERP (seconds
))
3957 if (XINT (seconds
) > 0)
3959 secs
= XINT (seconds
);
3963 else if (FLOATP (seconds
))
3965 if (XFLOAT_DATA (seconds
) > 0)
3967 struct timespec t
= dtotimespec (XFLOAT_DATA (seconds
));
3968 secs
= min (t
.tv_sec
, WAIT_READING_MAX
);
3973 wrong_type_argument (Qnumberp
, seconds
);
3975 else if (! NILP (process
))
3979 (wait_reading_process_output (secs
, nsecs
, 0, 0,
3981 !NILP (process
) ? XPROCESS (process
) : NULL
,
3982 NILP (just_this_one
) ? 0 :
3983 !INTEGERP (just_this_one
) ? 1 : -1)
3987 /* Accept a connection for server process SERVER on CHANNEL. */
3989 static EMACS_INT connect_counter
= 0;
3992 server_accept_connection (Lisp_Object server
, int channel
)
3994 Lisp_Object proc
, caller
, name
, buffer
;
3995 Lisp_Object contact
, host
, service
;
3996 struct Lisp_Process
*ps
= XPROCESS (server
);
3997 struct Lisp_Process
*p
;
4001 struct sockaddr_in in
;
4003 struct sockaddr_in6 in6
;
4005 #ifdef HAVE_LOCAL_SOCKETS
4006 struct sockaddr_un un
;
4009 socklen_t len
= sizeof saddr
;
4012 s
= accept4 (channel
, &saddr
.sa
, &len
, SOCK_CLOEXEC
);
4021 if (code
== EWOULDBLOCK
)
4025 if (!NILP (ps
->log
))
4026 call3 (ps
->log
, server
, Qnil
,
4027 concat3 (build_string ("accept failed with code"),
4028 Fnumber_to_string (make_number (code
)),
4029 build_string ("\n")));
4033 count
= SPECPDL_INDEX ();
4034 record_unwind_protect_int (close_file_unwind
, s
);
4038 /* Setup a new process to handle the connection. */
4040 /* Generate a unique identification of the caller, and build contact
4041 information for this process. */
4044 switch (saddr
.sa
.sa_family
)
4048 Lisp_Object args
[5];
4049 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4050 args
[0] = build_string ("%d.%d.%d.%d");
4051 args
[1] = make_number (*ip
++);
4052 args
[2] = make_number (*ip
++);
4053 args
[3] = make_number (*ip
++);
4054 args
[4] = make_number (*ip
++);
4055 host
= Fformat (5, args
);
4056 service
= make_number (ntohs (saddr
.in
.sin_port
));
4058 args
[0] = build_string (" <%s:%d>");
4061 caller
= Fformat (3, args
);
4068 Lisp_Object args
[9];
4069 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4071 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4072 for (i
= 0; i
< 8; i
++)
4073 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4074 host
= Fformat (9, args
);
4075 service
= make_number (ntohs (saddr
.in
.sin_port
));
4077 args
[0] = build_string (" <[%s]:%d>");
4080 caller
= Fformat (3, args
);
4085 #ifdef HAVE_LOCAL_SOCKETS
4089 caller
= Fnumber_to_string (make_number (connect_counter
));
4090 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4094 /* Create a new buffer name for this process if it doesn't have a
4095 filter. The new buffer name is based on the buffer name or
4096 process name of the server process concatenated with the caller
4099 if (!(EQ (ps
->filter
, Qinternal_default_process_filter
)
4100 || EQ (ps
->filter
, Qt
)))
4104 buffer
= ps
->buffer
;
4106 buffer
= Fbuffer_name (buffer
);
4111 buffer
= concat2 (buffer
, caller
);
4112 buffer
= Fget_buffer_create (buffer
);
4116 /* Generate a unique name for the new server process. Combine the
4117 server process name with the caller identification. */
4119 name
= concat2 (ps
->name
, caller
);
4120 proc
= make_process (name
);
4122 chan_process
[s
] = proc
;
4124 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4126 p
= XPROCESS (proc
);
4128 /* Build new contact information for this setup. */
4129 contact
= Fcopy_sequence (ps
->childp
);
4130 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4131 contact
= Fplist_put (contact
, QChost
, host
);
4132 if (!NILP (service
))
4133 contact
= Fplist_put (contact
, QCservice
, service
);
4134 contact
= Fplist_put (contact
, QCremote
,
4135 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4136 #ifdef HAVE_GETSOCKNAME
4138 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4139 contact
= Fplist_put (contact
, QClocal
,
4140 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4143 pset_childp (p
, contact
);
4144 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4145 pset_type (p
, Qnetwork
);
4147 pset_buffer (p
, buffer
);
4148 pset_sentinel (p
, ps
->sentinel
);
4149 pset_filter (p
, ps
->filter
);
4150 pset_command (p
, Qnil
);
4153 /* Discard the unwind protect for closing S. */
4154 specpdl_ptr
= specpdl
+ count
;
4156 p
->open_fd
[SUBPROCESS_STDIN
] = s
;
4159 pset_status (p
, Qrun
);
4161 /* Client processes for accepted connections are not stopped initially. */
4162 if (!EQ (p
->filter
, Qt
))
4164 FD_SET (s
, &input_wait_mask
);
4165 FD_SET (s
, &non_keyboard_wait_mask
);
4168 if (s
> max_process_desc
)
4169 max_process_desc
= s
;
4171 /* Setup coding system for new process based on server process.
4172 This seems to be the proper thing to do, as the coding system
4173 of the new process should reflect the settings at the time the
4174 server socket was opened; not the current settings. */
4176 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4177 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4178 setup_process_coding_systems (proc
);
4180 pset_decoding_buf (p
, empty_unibyte_string
);
4181 p
->decoding_carryover
= 0;
4182 pset_encoding_buf (p
, empty_unibyte_string
);
4184 p
->inherit_coding_system_flag
4185 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4187 if (!NILP (ps
->log
))
4188 call3 (ps
->log
, server
, proc
,
4189 concat3 (build_string ("accept from "),
4190 (STRINGP (host
) ? host
: build_string ("-")),
4191 build_string ("\n")));
4193 exec_sentinel (proc
,
4194 concat3 (build_string ("open from "),
4195 (STRINGP (host
) ? host
: build_string ("-")),
4196 build_string ("\n")));
4199 /* This variable is different from waiting_for_input in keyboard.c.
4200 It is used to communicate to a lisp process-filter/sentinel (via the
4201 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4202 for user-input when that process-filter was called.
4203 waiting_for_input cannot be used as that is by definition 0 when
4204 lisp code is being evalled.
4205 This is also used in record_asynch_buffer_change.
4206 For that purpose, this must be 0
4207 when not inside wait_reading_process_output. */
4208 static int waiting_for_user_input_p
;
4211 wait_reading_process_output_unwind (int data
)
4213 waiting_for_user_input_p
= data
;
4216 /* This is here so breakpoints can be put on it. */
4218 wait_reading_process_output_1 (void)
4222 /* Read and dispose of subprocess output while waiting for timeout to
4223 elapse and/or keyboard input to be available.
4227 If negative, gobble data immediately available but don't wait for any.
4230 an additional duration to wait, measured in nanoseconds
4231 If TIME_LIMIT is zero, then:
4232 If NSECS == 0, there is no limit.
4233 If NSECS > 0, the timeout consists of NSECS only.
4234 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4237 0 to ignore keyboard input, or
4238 1 to return when input is available, or
4239 -1 meaning caller will actually read the input, so don't throw to
4240 the quit handler, or
4242 DO_DISPLAY means redisplay should be done to show subprocess
4243 output that arrives.
4245 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4246 (and gobble terminal input into the buffer if any arrives).
4248 If WAIT_PROC is specified, wait until something arrives from that
4249 process. The return value is true if we read some input from
4252 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4253 (suspending output from other processes). A negative value
4254 means don't run any timers either.
4256 If WAIT_PROC is specified, then the function returns true if we
4257 received input from that process before the timeout elapsed.
4258 Otherwise, return true if we received input from any process. */
4261 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4263 Lisp_Object wait_for_cell
,
4264 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4274 struct timespec timeout
, end_time
;
4275 int wait_channel
= -1;
4276 bool got_some_input
= 0;
4277 ptrdiff_t count
= SPECPDL_INDEX ();
4279 FD_ZERO (&Available
);
4282 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4283 && !(CONSP (wait_proc
->status
)
4284 && EQ (XCAR (wait_proc
->status
), Qexit
)))
4285 message1 ("Blocking call to accept-process-output with quit inhibited!!");
4287 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4288 if (wait_proc
!= NULL
)
4289 wait_channel
= wait_proc
->infd
;
4291 record_unwind_protect_int (wait_reading_process_output_unwind
,
4292 waiting_for_user_input_p
);
4293 waiting_for_user_input_p
= read_kbd
;
4300 else if (TYPE_MAXIMUM (time_t) < time_limit
)
4301 time_limit
= TYPE_MAXIMUM (time_t);
4303 /* Since we may need to wait several times,
4304 compute the absolute time to return at. */
4305 if (time_limit
|| nsecs
> 0)
4307 timeout
= make_timespec (time_limit
, nsecs
);
4308 end_time
= timespec_add (current_timespec (), timeout
);
4313 bool timeout_reduced_for_timers
= 0;
4315 /* If calling from keyboard input, do not quit
4316 since we want to return C-g as an input character.
4317 Otherwise, do pending quit if requested. */
4320 else if (pending_signals
)
4321 process_pending_signals ();
4323 /* Exit now if the cell we're waiting for became non-nil. */
4324 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4327 /* Compute time from now till when time limit is up. */
4328 /* Exit if already run out. */
4331 /* A negative timeout means
4332 gobble output available now
4333 but don't wait at all. */
4335 timeout
= make_timespec (0, 0);
4337 else if (time_limit
|| nsecs
> 0)
4339 struct timespec now
= current_timespec ();
4340 if (timespec_cmp (end_time
, now
) <= 0)
4342 timeout
= timespec_sub (end_time
, now
);
4346 timeout
= make_timespec (100000, 0);
4349 /* Normally we run timers here.
4350 But not if wait_for_cell; in those cases,
4351 the wait is supposed to be short,
4352 and those callers cannot handle running arbitrary Lisp code here. */
4353 if (NILP (wait_for_cell
)
4354 && just_wait_proc
>= 0)
4356 struct timespec timer_delay
;
4360 unsigned old_timers_run
= timers_run
;
4361 struct buffer
*old_buffer
= current_buffer
;
4362 Lisp_Object old_window
= selected_window
;
4364 timer_delay
= timer_check ();
4366 /* If a timer has run, this might have changed buffers
4367 an alike. Make read_key_sequence aware of that. */
4368 if (timers_run
!= old_timers_run
4369 && (old_buffer
!= current_buffer
4370 || !EQ (old_window
, selected_window
))
4371 && waiting_for_user_input_p
== -1)
4372 record_asynch_buffer_change ();
4374 if (timers_run
!= old_timers_run
&& do_display
)
4375 /* We must retry, since a timer may have requeued itself
4376 and that could alter the time_delay. */
4377 redisplay_preserve_echo_area (9);
4381 while (!detect_input_pending ());
4383 /* If there is unread keyboard input, also return. */
4385 && requeued_events_pending_p ())
4388 /* A negative timeout means do not wait at all. */
4391 if (timespec_valid_p (timer_delay
))
4393 if (timespec_cmp (timer_delay
, timeout
) < 0)
4395 timeout
= timer_delay
;
4396 timeout_reduced_for_timers
= 1;
4401 /* This is so a breakpoint can be put here. */
4402 wait_reading_process_output_1 ();
4407 /* Cause C-g and alarm signals to take immediate action,
4408 and cause input available signals to zero out timeout.
4410 It is important that we do this before checking for process
4411 activity. If we get a SIGCHLD after the explicit checks for
4412 process activity, timeout is the only way we will know. */
4414 set_waiting_for_input (&timeout
);
4416 /* If status of something has changed, and no input is
4417 available, notify the user of the change right away. After
4418 this explicit check, we'll let the SIGCHLD handler zap
4419 timeout to get our attention. */
4420 if (update_tick
!= process_tick
)
4425 if (kbd_on_hold_p ())
4428 Atemp
= input_wait_mask
;
4431 timeout
= make_timespec (0, 0);
4432 if ((pselect (max (max_process_desc
, max_input_desc
) + 1,
4434 #ifdef NON_BLOCKING_CONNECT
4435 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
4439 NULL
, &timeout
, NULL
)
4442 /* It's okay for us to do this and then continue with
4443 the loop, since timeout has already been zeroed out. */
4444 clear_waiting_for_input ();
4445 status_notify (NULL
);
4446 if (do_display
) redisplay_preserve_echo_area (13);
4450 /* Don't wait for output from a non-running process. Just
4451 read whatever data has already been received. */
4452 if (wait_proc
&& wait_proc
->raw_status_new
)
4453 update_status (wait_proc
);
4455 && ! EQ (wait_proc
->status
, Qrun
)
4456 && ! EQ (wait_proc
->status
, Qconnect
))
4458 bool read_some_bytes
= 0;
4460 clear_waiting_for_input ();
4461 XSETPROCESS (proc
, wait_proc
);
4463 /* Read data from the process, until we exhaust it. */
4464 while (wait_proc
->infd
>= 0)
4466 int nread
= read_process_output (proc
, wait_proc
->infd
);
4472 got_some_input
= read_some_bytes
= 1;
4473 else if (nread
== -1 && (errno
== EIO
|| errno
== EAGAIN
))
4476 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4480 if (read_some_bytes
&& do_display
)
4481 redisplay_preserve_echo_area (10);
4486 /* Wait till there is something to do */
4488 if (wait_proc
&& just_wait_proc
)
4490 if (wait_proc
->infd
< 0) /* Terminated */
4492 FD_SET (wait_proc
->infd
, &Available
);
4496 else if (!NILP (wait_for_cell
))
4498 Available
= non_process_wait_mask
;
4505 Available
= non_keyboard_wait_mask
;
4507 Available
= input_wait_mask
;
4508 Writeok
= write_mask
;
4509 #ifdef SELECT_CANT_DO_WRITE_MASK
4514 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4517 /* If frame size has changed or the window is newly mapped,
4518 redisplay now, before we start to wait. There is a race
4519 condition here; if a SIGIO arrives between now and the select
4520 and indicates that a frame is trashed, the select may block
4521 displaying a trashed screen. */
4522 if (frame_garbaged
&& do_display
)
4524 clear_waiting_for_input ();
4525 redisplay_preserve_echo_area (11);
4527 set_waiting_for_input (&timeout
);
4530 /* Skip the `select' call if input is available and we're
4531 waiting for keyboard input or a cell change (which can be
4532 triggered by processing X events). In the latter case, set
4533 nfds to 1 to avoid breaking the loop. */
4535 if ((read_kbd
|| !NILP (wait_for_cell
))
4536 && detect_input_pending ())
4538 nfds
= read_kbd
? 0 : 1;
4545 #ifdef ADAPTIVE_READ_BUFFERING
4546 /* Set the timeout for adaptive read buffering if any
4547 process has non-zero read_output_skip and non-zero
4548 read_output_delay, and we are not reading output for a
4549 specific wait_channel. It is not executed if
4550 Vprocess_adaptive_read_buffering is nil. */
4551 if (process_output_skip
&& check_delay
> 0)
4553 int nsecs
= timeout
.tv_nsec
;
4554 if (timeout
.tv_sec
> 0 || nsecs
> READ_OUTPUT_DELAY_MAX
)
4555 nsecs
= READ_OUTPUT_DELAY_MAX
;
4556 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4558 proc
= chan_process
[channel
];
4561 /* Find minimum non-zero read_output_delay among the
4562 processes with non-zero read_output_skip. */
4563 if (XPROCESS (proc
)->read_output_delay
> 0)
4566 if (!XPROCESS (proc
)->read_output_skip
)
4568 FD_CLR (channel
, &Available
);
4569 XPROCESS (proc
)->read_output_skip
= 0;
4570 if (XPROCESS (proc
)->read_output_delay
< nsecs
)
4571 nsecs
= XPROCESS (proc
)->read_output_delay
;
4574 timeout
= make_timespec (0, nsecs
);
4575 process_output_skip
= 0;
4579 #if defined (HAVE_NS)
4581 #elif defined (HAVE_GLIB)
4586 (max (max_process_desc
, max_input_desc
) + 1,
4588 (check_write
? &Writeok
: 0),
4589 NULL
, &timeout
, NULL
);
4592 /* GnuTLS buffers data internally. In lowat mode it leaves
4593 some data in the TCP buffers so that select works, but
4594 with custom pull/push functions we need to check if some
4595 data is available in the buffers manually. */
4600 /* We're not waiting on a specific process, so loop
4601 through all the channels and check for data.
4602 This is a workaround needed for some versions of
4603 the gnutls library -- 2.12.14 has been confirmed
4605 http://comments.gmane.org/gmane.emacs.devel/145074 */
4606 for (channel
= 0; channel
< FD_SETSIZE
; ++channel
)
4607 if (! NILP (chan_process
[channel
]))
4609 struct Lisp_Process
*p
=
4610 XPROCESS (chan_process
[channel
]);
4611 if (p
&& p
->gnutls_p
&& p
->gnutls_state
&& p
->infd
4612 && ((emacs_gnutls_record_check_pending
4617 FD_SET (p
->infd
, &Available
);
4623 /* Check this specific channel. */
4624 if (wait_proc
->gnutls_p
/* Check for valid process. */
4625 && wait_proc
->gnutls_state
4626 /* Do we have pending data? */
4627 && ((emacs_gnutls_record_check_pending
4628 (wait_proc
->gnutls_state
))
4632 /* Set to Available. */
4633 FD_SET (wait_proc
->infd
, &Available
);
4642 /* Make C-g and alarm signals set flags again */
4643 clear_waiting_for_input ();
4645 /* If we woke up due to SIGWINCH, actually change size now. */
4646 do_pending_window_change (0);
4648 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
4649 /* We waited the full specified time, so return now. */
4653 if (xerrno
== EINTR
)
4655 else if (xerrno
== EBADF
)
4658 report_file_errno ("Failed select", Qnil
, xerrno
);
4663 FD_ZERO (&Available
);
4667 /* Check for keyboard input */
4668 /* If there is any, return immediately
4669 to give it higher priority than subprocesses */
4673 unsigned old_timers_run
= timers_run
;
4674 struct buffer
*old_buffer
= current_buffer
;
4675 Lisp_Object old_window
= selected_window
;
4678 if (detect_input_pending_run_timers (do_display
))
4680 swallow_events (do_display
);
4681 if (detect_input_pending_run_timers (do_display
))
4685 /* If a timer has run, this might have changed buffers
4686 an alike. Make read_key_sequence aware of that. */
4687 if (timers_run
!= old_timers_run
4688 && waiting_for_user_input_p
== -1
4689 && (old_buffer
!= current_buffer
4690 || !EQ (old_window
, selected_window
)))
4691 record_asynch_buffer_change ();
4697 /* If there is unread keyboard input, also return. */
4699 && requeued_events_pending_p ())
4702 /* If we are not checking for keyboard input now,
4703 do process events (but don't run any timers).
4704 This is so that X events will be processed.
4705 Otherwise they may have to wait until polling takes place.
4706 That would causes delays in pasting selections, for example.
4708 (We used to do this only if wait_for_cell.) */
4709 if (read_kbd
== 0 && detect_input_pending ())
4711 swallow_events (do_display
);
4712 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4713 if (detect_input_pending ())
4718 /* Exit now if the cell we're waiting for became non-nil. */
4719 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4723 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4724 go read it. This can happen with X on BSD after logging out.
4725 In that case, there really is no input and no SIGIO,
4726 but select says there is input. */
4728 if (read_kbd
&& interrupt_input
4729 && keyboard_bit_set (&Available
) && ! noninteractive
)
4730 handle_input_available_signal (SIGIO
);
4734 got_some_input
|= nfds
> 0;
4736 /* If checking input just got us a size-change event from X,
4737 obey it now if we should. */
4738 if (read_kbd
|| ! NILP (wait_for_cell
))
4739 do_pending_window_change (0);
4741 /* Check for data from a process. */
4742 if (no_avail
|| nfds
== 0)
4745 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4747 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4749 && ((d
->condition
& FOR_READ
4750 && FD_ISSET (channel
, &Available
))
4751 || (d
->condition
& FOR_WRITE
4752 && FD_ISSET (channel
, &write_mask
))))
4753 d
->func (channel
, d
->data
);
4756 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4758 if (FD_ISSET (channel
, &Available
)
4759 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4760 && !FD_ISSET (channel
, &non_process_wait_mask
))
4764 /* If waiting for this channel, arrange to return as
4765 soon as no more input to be processed. No more
4767 if (wait_channel
== channel
)
4773 proc
= chan_process
[channel
];
4777 /* If this is a server stream socket, accept connection. */
4778 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4780 server_accept_connection (proc
, channel
);
4784 /* Read data from the process, starting with our
4785 buffered-ahead character if we have one. */
4787 nread
= read_process_output (proc
, channel
);
4790 /* Since read_process_output can run a filter,
4791 which can call accept-process-output,
4792 don't try to read from any other processes
4793 before doing the select again. */
4794 FD_ZERO (&Available
);
4797 redisplay_preserve_echo_area (12);
4800 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4803 else if (nread
== -1 && errno
== EAGAIN
)
4806 /* FIXME: Is this special case still needed? */
4807 /* Note that we cannot distinguish between no input
4808 available now and a closed pipe.
4809 With luck, a closed pipe will be accompanied by
4810 subprocess termination and SIGCHLD. */
4811 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4815 /* On some OSs with ptys, when the process on one end of
4816 a pty exits, the other end gets an error reading with
4817 errno = EIO instead of getting an EOF (0 bytes read).
4818 Therefore, if we get an error reading and errno =
4819 EIO, just continue, because the child process has
4820 exited and should clean itself up soon (e.g. when we
4822 else if (nread
== -1 && errno
== EIO
)
4824 struct Lisp_Process
*p
= XPROCESS (proc
);
4826 /* Clear the descriptor now, so we only raise the
4828 FD_CLR (channel
, &input_wait_mask
);
4829 FD_CLR (channel
, &non_keyboard_wait_mask
);
4833 /* If the EIO occurs on a pty, the SIGCHLD handler's
4834 waitpid call will not find the process object to
4835 delete. Do it here. */
4836 p
->tick
= ++process_tick
;
4837 pset_status (p
, Qfailed
);
4840 #endif /* HAVE_PTYS */
4841 /* If we can detect process termination, don't consider the
4842 process gone just because its pipe is closed. */
4843 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4847 /* Preserve status of processes already terminated. */
4848 XPROCESS (proc
)->tick
= ++process_tick
;
4849 deactivate_process (proc
);
4850 if (XPROCESS (proc
)->raw_status_new
)
4851 update_status (XPROCESS (proc
));
4852 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4853 pset_status (XPROCESS (proc
),
4854 list2 (Qexit
, make_number (256)));
4857 #ifdef NON_BLOCKING_CONNECT
4858 if (FD_ISSET (channel
, &Writeok
)
4859 && FD_ISSET (channel
, &connect_wait_mask
))
4861 struct Lisp_Process
*p
;
4863 FD_CLR (channel
, &connect_wait_mask
);
4864 FD_CLR (channel
, &write_mask
);
4865 if (--num_pending_connects
< 0)
4868 proc
= chan_process
[channel
];
4872 p
= XPROCESS (proc
);
4875 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4876 So only use it on systems where it is known to work. */
4878 socklen_t xlen
= sizeof (xerrno
);
4879 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4884 struct sockaddr pname
;
4885 socklen_t pnamelen
= sizeof (pname
);
4887 /* If connection failed, getpeername will fail. */
4889 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
4891 /* Obtain connect failure code through error slippage. */
4894 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
4901 p
->tick
= ++process_tick
;
4902 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
4903 deactivate_process (proc
);
4907 pset_status (p
, Qrun
);
4908 /* Execute the sentinel here. If we had relied on
4909 status_notify to do it later, it will read input
4910 from the process before calling the sentinel. */
4911 exec_sentinel (proc
, build_string ("open\n"));
4912 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4914 FD_SET (p
->infd
, &input_wait_mask
);
4915 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
4919 #endif /* NON_BLOCKING_CONNECT */
4920 } /* End for each file descriptor. */
4921 } /* End while exit conditions not met. */
4923 unbind_to (count
, Qnil
);
4925 /* If calling from keyboard input, do not quit
4926 since we want to return C-g as an input character.
4927 Otherwise, do pending quit if requested. */
4930 /* Prevent input_pending from remaining set if we quit. */
4931 clear_input_pending ();
4935 return got_some_input
;
4938 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4941 read_process_output_call (Lisp_Object fun_and_args
)
4943 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4947 read_process_output_error_handler (Lisp_Object error_val
)
4949 cmd_error_internal (error_val
, "error in process filter: ");
4951 update_echo_area ();
4952 Fsleep_for (make_number (2), Qnil
);
4957 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
4959 struct coding_system
*coding
);
4961 /* Read pending output from the process channel,
4962 starting with our buffered-ahead character if we have one.
4963 Yield number of decoded characters read.
4965 This function reads at most 4096 characters.
4966 If you want to read all available subprocess output,
4967 you must call it repeatedly until it returns zero.
4969 The characters read are decoded according to PROC's coding-system
4973 read_process_output (Lisp_Object proc
, register int channel
)
4975 register ssize_t nbytes
;
4977 register struct Lisp_Process
*p
= XPROCESS (proc
);
4978 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4979 int carryover
= p
->decoding_carryover
;
4981 ptrdiff_t count
= SPECPDL_INDEX ();
4982 Lisp_Object odeactivate
;
4984 chars
= alloca (carryover
+ readmax
);
4986 /* See the comment above. */
4987 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
4989 #ifdef DATAGRAM_SOCKETS
4990 /* We have a working select, so proc_buffered_char is always -1. */
4991 if (DATAGRAM_CHAN_P (channel
))
4993 socklen_t len
= datagram_address
[channel
].len
;
4994 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4995 0, datagram_address
[channel
].sa
, &len
);
5000 bool buffered
= proc_buffered_char
[channel
] >= 0;
5003 chars
[carryover
] = proc_buffered_char
[channel
];
5004 proc_buffered_char
[channel
] = -1;
5007 if (p
->gnutls_p
&& p
->gnutls_state
)
5008 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5009 readmax
- buffered
);
5012 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5013 readmax
- buffered
);
5014 #ifdef ADAPTIVE_READ_BUFFERING
5015 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5017 int delay
= p
->read_output_delay
;
5020 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5023 process_output_delay_count
++;
5024 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5027 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5029 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5031 process_output_delay_count
--;
5033 p
->read_output_delay
= delay
;
5036 p
->read_output_skip
= 1;
5037 process_output_skip
= 1;
5042 nbytes
+= buffered
&& nbytes
<= 0;
5045 p
->decoding_carryover
= 0;
5047 /* At this point, NBYTES holds number of bytes just received
5048 (including the one in proc_buffered_char[channel]). */
5051 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5053 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5056 /* Now set NBYTES how many bytes we must decode. */
5057 nbytes
+= carryover
;
5059 odeactivate
= Vdeactivate_mark
;
5060 /* There's no good reason to let process filters change the current
5061 buffer, and many callers of accept-process-output, sit-for, and
5062 friends don't expect current-buffer to be changed from under them. */
5063 record_unwind_current_buffer ();
5065 read_and_dispose_of_process_output (p
, chars
, nbytes
, coding
);
5067 /* Handling the process output should not deactivate the mark. */
5068 Vdeactivate_mark
= odeactivate
;
5070 unbind_to (count
, Qnil
);
5075 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5077 struct coding_system
*coding
)
5079 Lisp_Object outstream
= p
->filter
;
5081 bool outer_running_asynch_code
= running_asynch_code
;
5082 int waiting
= waiting_for_user_input_p
;
5084 /* No need to gcpro these, because all we do with them later
5085 is test them for EQness, and none of them should be a string. */
5087 Lisp_Object obuffer
, okeymap
;
5088 XSETBUFFER (obuffer
, current_buffer
);
5089 okeymap
= BVAR (current_buffer
, keymap
);
5092 /* We inhibit quit here instead of just catching it so that
5093 hitting ^G when a filter happens to be running won't screw
5095 specbind (Qinhibit_quit
, Qt
);
5096 specbind (Qlast_nonmenu_event
, Qt
);
5098 /* In case we get recursively called,
5099 and we already saved the match data nonrecursively,
5100 save the same match data in safely recursive fashion. */
5101 if (outer_running_asynch_code
)
5104 /* Don't clobber the CURRENT match data, either! */
5105 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5106 restore_search_regs ();
5107 record_unwind_save_match_data ();
5108 Fset_match_data (tem
, Qt
);
5111 /* For speed, if a search happens within this code,
5112 save the match data in a special nonrecursive fashion. */
5113 running_asynch_code
= 1;
5115 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5116 text
= coding
->dst_object
;
5117 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5118 /* A new coding system might be found. */
5119 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5121 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5123 /* Don't call setup_coding_system for
5124 proc_decode_coding_system[channel] here. It is done in
5125 detect_coding called via decode_coding above. */
5127 /* If a coding system for encoding is not yet decided, we set
5128 it as the same as coding-system for decoding.
5130 But, before doing that we must check if
5131 proc_encode_coding_system[p->outfd] surely points to a
5132 valid memory because p->outfd will be changed once EOF is
5133 sent to the process. */
5134 if (NILP (p
->encode_coding_system
)
5135 && proc_encode_coding_system
[p
->outfd
])
5137 pset_encode_coding_system
5138 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5139 setup_coding_system (p
->encode_coding_system
,
5140 proc_encode_coding_system
[p
->outfd
]);
5144 if (coding
->carryover_bytes
> 0)
5146 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5147 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5148 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5149 coding
->carryover_bytes
);
5150 p
->decoding_carryover
= coding
->carryover_bytes
;
5152 if (SBYTES (text
) > 0)
5153 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5154 sometimes it's simply wrong to wrap (e.g. when called from
5155 accept-process-output). */
5156 internal_condition_case_1 (read_process_output_call
,
5157 list3 (outstream
, make_lisp_proc (p
), text
),
5158 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5159 read_process_output_error_handler
);
5161 /* If we saved the match data nonrecursively, restore it now. */
5162 restore_search_regs ();
5163 running_asynch_code
= outer_running_asynch_code
;
5165 /* Restore waiting_for_user_input_p as it was
5166 when we were called, in case the filter clobbered it. */
5167 waiting_for_user_input_p
= waiting
;
5169 #if 0 /* Call record_asynch_buffer_change unconditionally,
5170 because we might have changed minor modes or other things
5171 that affect key bindings. */
5172 if (! EQ (Fcurrent_buffer (), obuffer
)
5173 || ! EQ (current_buffer
->keymap
, okeymap
))
5175 /* But do it only if the caller is actually going to read events.
5176 Otherwise there's no need to make him wake up, and it could
5177 cause trouble (for example it would make sit_for return). */
5178 if (waiting_for_user_input_p
== -1)
5179 record_asynch_buffer_change ();
5182 DEFUN ("internal-default-process-filter", Finternal_default_process_filter
,
5183 Sinternal_default_process_filter
, 2, 2, 0,
5184 doc
: /* Function used as default process filter. */)
5185 (Lisp_Object proc
, Lisp_Object text
)
5187 struct Lisp_Process
*p
;
5190 CHECK_PROCESS (proc
);
5191 p
= XPROCESS (proc
);
5192 CHECK_STRING (text
);
5194 if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
5196 Lisp_Object old_read_only
;
5197 ptrdiff_t old_begv
, old_zv
;
5198 ptrdiff_t old_begv_byte
, old_zv_byte
;
5199 ptrdiff_t before
, before_byte
;
5200 ptrdiff_t opoint_byte
;
5203 Fset_buffer (p
->buffer
);
5205 opoint_byte
= PT_BYTE
;
5206 old_read_only
= BVAR (current_buffer
, read_only
);
5209 old_begv_byte
= BEGV_BYTE
;
5210 old_zv_byte
= ZV_BYTE
;
5212 bset_read_only (current_buffer
, Qnil
);
5214 /* Insert new output into buffer at the current end-of-output
5215 marker, thus preserving logical ordering of input and output. */
5216 if (XMARKER (p
->mark
)->buffer
)
5217 set_point_from_marker (p
->mark
);
5219 SET_PT_BOTH (ZV
, ZV_BYTE
);
5221 before_byte
= PT_BYTE
;
5223 /* If the output marker is outside of the visible region, save
5224 the restriction and widen. */
5225 if (! (BEGV
<= PT
&& PT
<= ZV
))
5228 /* Adjust the multibyteness of TEXT to that of the buffer. */
5229 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5230 != ! STRING_MULTIBYTE (text
))
5231 text
= (STRING_MULTIBYTE (text
)
5232 ? Fstring_as_unibyte (text
)
5233 : Fstring_to_multibyte (text
));
5234 /* Insert before markers in case we are inserting where
5235 the buffer's mark is, and the user's next command is Meta-y. */
5236 insert_from_string_before_markers (text
, 0, 0,
5237 SCHARS (text
), SBYTES (text
), 0);
5239 /* Make sure the process marker's position is valid when the
5240 process buffer is changed in the signal_after_change above.
5241 W3 is known to do that. */
5242 if (BUFFERP (p
->buffer
)
5243 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5244 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5246 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5248 update_mode_lines
= 23;
5250 /* Make sure opoint and the old restrictions
5251 float ahead of any new text just as point would. */
5252 if (opoint
>= before
)
5254 opoint
+= PT
- before
;
5255 opoint_byte
+= PT_BYTE
- before_byte
;
5257 if (old_begv
> before
)
5259 old_begv
+= PT
- before
;
5260 old_begv_byte
+= PT_BYTE
- before_byte
;
5262 if (old_zv
>= before
)
5264 old_zv
+= PT
- before
;
5265 old_zv_byte
+= PT_BYTE
- before_byte
;
5268 /* If the restriction isn't what it should be, set it. */
5269 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5270 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5272 bset_read_only (current_buffer
, old_read_only
);
5273 SET_PT_BOTH (opoint
, opoint_byte
);
5278 /* Sending data to subprocess. */
5280 /* In send_process, when a write fails temporarily,
5281 wait_reading_process_output is called. It may execute user code,
5282 e.g. timers, that attempts to write new data to the same process.
5283 We must ensure that data is sent in the right order, and not
5284 interspersed half-completed with other writes (Bug#10815). This is
5285 handled by the write_queue element of struct process. It is a list
5286 with each entry having the form
5288 (string . (offset . length))
5290 where STRING is a lisp string, OFFSET is the offset into the
5291 string's byte sequence from which we should begin to send, and
5292 LENGTH is the number of bytes left to send. */
5294 /* Create a new entry in write_queue.
5295 INPUT_OBJ should be a buffer, string Qt, or Qnil.
5296 BUF is a pointer to the string sequence of the input_obj or a C
5297 string in case of Qt or Qnil. */
5300 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
5301 const char *buf
, ptrdiff_t len
, bool front
)
5304 Lisp_Object entry
, obj
;
5306 if (STRINGP (input_obj
))
5308 offset
= buf
- SSDATA (input_obj
);
5314 obj
= make_unibyte_string (buf
, len
);
5317 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
5320 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
5322 pset_write_queue (p
, nconc2 (p
->write_queue
, list1 (entry
)));
5325 /* Remove the first element in the write_queue of process P, put its
5326 contents in OBJ, BUF and LEN, and return true. If the
5327 write_queue is empty, return false. */
5330 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
5331 const char **buf
, ptrdiff_t *len
)
5333 Lisp_Object entry
, offset_length
;
5336 if (NILP (p
->write_queue
))
5339 entry
= XCAR (p
->write_queue
);
5340 pset_write_queue (p
, XCDR (p
->write_queue
));
5342 *obj
= XCAR (entry
);
5343 offset_length
= XCDR (entry
);
5345 *len
= XINT (XCDR (offset_length
));
5346 offset
= XINT (XCAR (offset_length
));
5347 *buf
= SSDATA (*obj
) + offset
;
5352 /* Send some data to process PROC.
5353 BUF is the beginning of the data; LEN is the number of characters.
5354 OBJECT is the Lisp object that the data comes from. If OBJECT is
5355 nil or t, it means that the data comes from C string.
5357 If OBJECT is not nil, the data is encoded by PROC's coding-system
5358 for encoding before it is sent.
5360 This function can evaluate Lisp code and can garbage collect. */
5363 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
5366 struct Lisp_Process
*p
= XPROCESS (proc
);
5368 struct coding_system
*coding
;
5370 if (p
->raw_status_new
)
5372 if (! EQ (p
->status
, Qrun
))
5373 error ("Process %s not running", SDATA (p
->name
));
5375 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5377 coding
= proc_encode_coding_system
[p
->outfd
];
5378 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5380 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5381 || (BUFFERP (object
)
5382 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
5385 pset_encode_coding_system
5386 (p
, complement_process_encoding_system (p
->encode_coding_system
));
5387 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5389 /* The coding system for encoding was changed to raw-text
5390 because we sent a unibyte text previously. Now we are
5391 sending a multibyte text, thus we must encode it by the
5392 original coding system specified for the current process.
5394 Another reason we come here is that the coding system
5395 was just complemented and a new one was returned by
5396 complement_process_encoding_system. */
5397 setup_coding_system (p
->encode_coding_system
, coding
);
5398 Vlast_coding_system_used
= p
->encode_coding_system
;
5400 coding
->src_multibyte
= 1;
5404 coding
->src_multibyte
= 0;
5405 /* For sending a unibyte text, character code conversion should
5406 not take place but EOL conversion should. So, setup raw-text
5407 or one of the subsidiary if we have not yet done it. */
5408 if (CODING_REQUIRE_ENCODING (coding
))
5410 if (CODING_REQUIRE_FLUSHING (coding
))
5412 /* But, before changing the coding, we must flush out data. */
5413 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5414 send_process (proc
, "", 0, Qt
);
5415 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5417 setup_coding_system (raw_text_coding_system
5418 (Vlast_coding_system_used
),
5420 coding
->src_multibyte
= 0;
5423 coding
->dst_multibyte
= 0;
5425 if (CODING_REQUIRE_ENCODING (coding
))
5427 coding
->dst_object
= Qt
;
5428 if (BUFFERP (object
))
5430 ptrdiff_t from_byte
, from
, to
;
5431 ptrdiff_t save_pt
, save_pt_byte
;
5432 struct buffer
*cur
= current_buffer
;
5434 set_buffer_internal (XBUFFER (object
));
5435 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5437 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
5438 from
= BYTE_TO_CHAR (from_byte
);
5439 to
= BYTE_TO_CHAR (from_byte
+ len
);
5440 TEMP_SET_PT_BOTH (from
, from_byte
);
5441 encode_coding_object (coding
, object
, from
, from_byte
,
5442 to
, from_byte
+ len
, Qt
);
5443 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5444 set_buffer_internal (cur
);
5446 else if (STRINGP (object
))
5448 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5449 SBYTES (object
), Qt
);
5453 coding
->dst_object
= make_unibyte_string (buf
, len
);
5454 coding
->produced
= len
;
5457 len
= coding
->produced
;
5458 object
= coding
->dst_object
;
5459 buf
= SSDATA (object
);
5462 /* If there is already data in the write_queue, put the new data
5463 in the back of queue. Otherwise, ignore it. */
5464 if (!NILP (p
->write_queue
))
5465 write_queue_push (p
, object
, buf
, len
, 0);
5467 do /* while !NILP (p->write_queue) */
5469 ptrdiff_t cur_len
= -1;
5470 const char *cur_buf
;
5471 Lisp_Object cur_object
;
5473 /* If write_queue is empty, ignore it. */
5474 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
5478 cur_object
= object
;
5483 /* Send this batch, using one or more write calls. */
5484 ptrdiff_t written
= 0;
5485 int outfd
= p
->outfd
;
5486 #ifdef DATAGRAM_SOCKETS
5487 if (DATAGRAM_CHAN_P (outfd
))
5489 rv
= sendto (outfd
, cur_buf
, cur_len
,
5490 0, datagram_address
[outfd
].sa
,
5491 datagram_address
[outfd
].len
);
5494 else if (errno
== EMSGSIZE
)
5495 report_file_error ("Sending datagram", proc
);
5501 if (p
->gnutls_p
&& p
->gnutls_state
)
5502 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
5505 written
= emacs_write_sig (outfd
, cur_buf
, cur_len
);
5506 rv
= (written
? 0 : -1);
5507 #ifdef ADAPTIVE_READ_BUFFERING
5508 if (p
->read_output_delay
> 0
5509 && p
->adaptive_read_buffering
== 1)
5511 p
->read_output_delay
= 0;
5512 process_output_delay_count
--;
5513 p
->read_output_skip
= 0;
5522 || errno
== EWOULDBLOCK
5525 /* Buffer is full. Wait, accepting input;
5526 that may allow the program
5527 to finish doing output and read more. */
5529 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5530 /* A gross hack to work around a bug in FreeBSD.
5531 In the following sequence, read(2) returns
5535 write(2) 954 bytes, get EAGAIN
5536 read(2) 1024 bytes in process_read_output
5537 read(2) 11 bytes in process_read_output
5539 That is, read(2) returns more bytes than have
5540 ever been written successfully. The 1033 bytes
5541 read are the 1022 bytes written successfully
5542 after processing (for example with CRs added if
5543 the terminal is set up that way which it is
5544 here). The same bytes will be seen again in a
5545 later read(2), without the CRs. */
5547 if (errno
== EAGAIN
)
5550 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5552 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5554 /* Put what we should have written in wait_queue. */
5555 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
5556 wait_reading_process_output (0, 20 * 1000 * 1000,
5557 0, 0, Qnil
, NULL
, 0);
5558 /* Reread queue, to see what is left. */
5561 else if (errno
== EPIPE
)
5563 p
->raw_status_new
= 0;
5564 pset_status (p
, list2 (Qexit
, make_number (256)));
5565 p
->tick
= ++process_tick
;
5566 deactivate_process (proc
);
5567 error ("process %s no longer connected to pipe; closed it",
5571 /* This is a real error. */
5572 report_file_error ("Writing to process", proc
);
5578 while (!NILP (p
->write_queue
));
5581 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5583 doc
: /* Send current contents of region as input to PROCESS.
5584 PROCESS may be a process, a buffer, the name of a process or buffer, or
5585 nil, indicating the current buffer's process.
5586 Called from program, takes three arguments, PROCESS, START and END.
5587 If the region is more than 500 characters long,
5588 it is sent in several bunches. This may happen even for shorter regions.
5589 Output from processes can arrive in between bunches. */)
5590 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5592 Lisp_Object proc
= get_process (process
);
5593 ptrdiff_t start_byte
, end_byte
;
5595 validate_region (&start
, &end
);
5597 start_byte
= CHAR_TO_BYTE (XINT (start
));
5598 end_byte
= CHAR_TO_BYTE (XINT (end
));
5600 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5601 move_gap_both (XINT (start
), start_byte
);
5603 send_process (proc
, (char *) BYTE_POS_ADDR (start_byte
),
5604 end_byte
- start_byte
, Fcurrent_buffer ());
5609 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5611 doc
: /* Send PROCESS the contents of STRING as input.
5612 PROCESS may be a process, a buffer, the name of a process or buffer, or
5613 nil, indicating the current buffer's process.
5614 If STRING is more than 500 characters long,
5615 it is sent in several bunches. This may happen even for shorter strings.
5616 Output from processes can arrive in between bunches. */)
5617 (Lisp_Object process
, Lisp_Object string
)
5620 CHECK_STRING (string
);
5621 proc
= get_process (process
);
5622 send_process (proc
, SSDATA (string
),
5623 SBYTES (string
), string
);
5627 /* Return the foreground process group for the tty/pty that
5628 the process P uses. */
5630 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5635 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5638 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5639 master side. Try the slave side. */
5640 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
5644 ioctl (fd
, TIOCGPGRP
, &gid
);
5648 #endif /* defined (TIOCGPGRP ) */
5653 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5654 Sprocess_running_child_p
, 0, 1, 0,
5655 doc
: /* Return t if PROCESS has given the terminal to a child.
5656 If the operating system does not make it possible to find out,
5657 return t unconditionally. */)
5658 (Lisp_Object process
)
5660 /* Initialize in case ioctl doesn't exist or gives an error,
5661 in a way that will cause returning t. */
5664 struct Lisp_Process
*p
;
5666 proc
= get_process (process
);
5667 p
= XPROCESS (proc
);
5669 if (!EQ (p
->type
, Qreal
))
5670 error ("Process %s is not a subprocess",
5673 error ("Process %s is not active",
5676 gid
= emacs_get_tty_pgrp (p
);
5683 /* send a signal number SIGNO to PROCESS.
5684 If CURRENT_GROUP is t, that means send to the process group
5685 that currently owns the terminal being used to communicate with PROCESS.
5686 This is used for various commands in shell mode.
5687 If CURRENT_GROUP is lambda, that means send to the process group
5688 that currently owns the terminal, but only if it is NOT the shell itself.
5690 If NOMSG is false, insert signal-announcements into process's buffers
5693 If we can, we try to signal PROCESS by sending control characters
5694 down the pty. This allows us to signal inferiors who have changed
5695 their uid, for which kill would return an EPERM error. */
5698 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5702 struct Lisp_Process
*p
;
5706 proc
= get_process (process
);
5707 p
= XPROCESS (proc
);
5709 if (!EQ (p
->type
, Qreal
))
5710 error ("Process %s is not a subprocess",
5713 error ("Process %s is not active",
5717 current_group
= Qnil
;
5719 /* If we are using pgrps, get a pgrp number and make it negative. */
5720 if (NILP (current_group
))
5721 /* Send the signal to the shell's process group. */
5725 #ifdef SIGNALS_VIA_CHARACTERS
5726 /* If possible, send signals to the entire pgrp
5727 by sending an input character to it. */
5730 cc_t
*sig_char
= NULL
;
5732 tcgetattr (p
->infd
, &t
);
5737 sig_char
= &t
.c_cc
[VINTR
];
5741 sig_char
= &t
.c_cc
[VQUIT
];
5745 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5746 sig_char
= &t
.c_cc
[VSWTCH
];
5748 sig_char
= &t
.c_cc
[VSUSP
];
5753 if (sig_char
&& *sig_char
!= CDISABLE
)
5755 send_process (proc
, (char *) sig_char
, 1, Qnil
);
5758 /* If we can't send the signal with a character,
5759 fall through and send it another way. */
5761 /* The code above may fall through if it can't
5762 handle the signal. */
5763 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5766 /* Get the current pgrp using the tty itself, if we have that.
5767 Otherwise, use the pty to get the pgrp.
5768 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5769 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5770 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5771 His patch indicates that if TIOCGPGRP returns an error, then
5772 we should just assume that p->pid is also the process group id. */
5774 gid
= emacs_get_tty_pgrp (p
);
5777 /* If we can't get the information, assume
5778 the shell owns the tty. */
5781 /* It is not clear whether anything really can set GID to -1.
5782 Perhaps on some system one of those ioctls can or could do so.
5783 Or perhaps this is vestigial. */
5786 #else /* ! defined (TIOCGPGRP ) */
5787 /* Can't select pgrps on this system, so we know that
5788 the child itself heads the pgrp. */
5790 #endif /* ! defined (TIOCGPGRP ) */
5792 /* If current_group is lambda, and the shell owns the terminal,
5793 don't send any signal. */
5794 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5799 if (signo
== SIGCONT
)
5801 p
->raw_status_new
= 0;
5802 pset_status (p
, Qrun
);
5803 p
->tick
= ++process_tick
;
5806 status_notify (NULL
);
5807 redisplay_preserve_echo_area (13);
5812 /* If we don't have process groups, send the signal to the immediate
5813 subprocess. That isn't really right, but it's better than any
5814 obvious alternative. */
5817 kill (p
->pid
, signo
);
5821 /* gid may be a pid, or minus a pgrp's number */
5823 if (!NILP (current_group
))
5825 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
5833 #else /* ! defined (TIOCSIGSEND) */
5835 #endif /* ! defined (TIOCSIGSEND) */
5838 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5839 doc
: /* Interrupt process PROCESS.
5840 PROCESS may be a process, a buffer, or the name of a process or buffer.
5841 No arg or nil means current buffer's process.
5842 Second arg CURRENT-GROUP non-nil means send signal to
5843 the current process-group of the process's controlling terminal
5844 rather than to the process's own process group.
5845 If the process is a shell, this means interrupt current subjob
5846 rather than the shell.
5848 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5849 don't send the signal. */)
5850 (Lisp_Object process
, Lisp_Object current_group
)
5852 process_send_signal (process
, SIGINT
, current_group
, 0);
5856 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5857 doc
: /* Kill process PROCESS. May be process or name of one.
5858 See function `interrupt-process' for more details on usage. */)
5859 (Lisp_Object process
, Lisp_Object current_group
)
5861 process_send_signal (process
, SIGKILL
, current_group
, 0);
5865 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5866 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5867 See function `interrupt-process' for more details on usage. */)
5868 (Lisp_Object process
, Lisp_Object current_group
)
5870 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5874 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5875 doc
: /* Stop process PROCESS. May be process or name of one.
5876 See function `interrupt-process' for more details on usage.
5877 If PROCESS is a network or serial process, inhibit handling of incoming
5879 (Lisp_Object process
, Lisp_Object current_group
)
5881 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5883 struct Lisp_Process
*p
;
5885 p
= XPROCESS (process
);
5886 if (NILP (p
->command
)
5889 FD_CLR (p
->infd
, &input_wait_mask
);
5890 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
5892 pset_command (p
, Qt
);
5896 error ("No SIGTSTP support");
5898 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5903 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5904 doc
: /* Continue process PROCESS. May be process or name of one.
5905 See function `interrupt-process' for more details on usage.
5906 If PROCESS is a network or serial process, resume handling of incoming
5908 (Lisp_Object process
, Lisp_Object current_group
)
5910 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5912 struct Lisp_Process
*p
;
5914 p
= XPROCESS (process
);
5915 if (EQ (p
->command
, Qt
)
5917 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5919 FD_SET (p
->infd
, &input_wait_mask
);
5920 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5922 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
5923 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
5924 #else /* not WINDOWSNT */
5925 tcflush (p
->infd
, TCIFLUSH
);
5926 #endif /* not WINDOWSNT */
5928 pset_command (p
, Qnil
);
5932 process_send_signal (process
, SIGCONT
, current_group
, 0);
5934 error ("No SIGCONT support");
5939 /* Return the integer value of the signal whose abbreviation is ABBR,
5940 or a negative number if there is no such signal. */
5942 abbr_to_signal (char const *name
)
5945 char sigbuf
[20]; /* Large enough for all valid signal abbreviations. */
5947 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
5950 for (i
= 0; i
< sizeof sigbuf
; i
++)
5952 sigbuf
[i
] = c_toupper (name
[i
]);
5954 return str2sig (sigbuf
, &signo
) == 0 ? signo
: -1;
5960 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5961 2, 2, "sProcess (name or number): \nnSignal code: ",
5962 doc
: /* Send PROCESS the signal with code SIGCODE.
5963 PROCESS may also be a number specifying the process id of the
5964 process to signal; in this case, the process need not be a child of
5966 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5967 (Lisp_Object process
, Lisp_Object sigcode
)
5972 if (STRINGP (process
))
5974 Lisp_Object tem
= Fget_process (process
);
5977 Lisp_Object process_number
=
5978 string_to_number (SSDATA (process
), 10, 1);
5979 if (INTEGERP (process_number
) || FLOATP (process_number
))
5980 tem
= process_number
;
5984 else if (!NUMBERP (process
))
5985 process
= get_process (process
);
5990 if (NUMBERP (process
))
5991 CONS_TO_INTEGER (process
, pid_t
, pid
);
5994 CHECK_PROCESS (process
);
5995 pid
= XPROCESS (process
)->pid
;
5997 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6000 if (INTEGERP (sigcode
))
6002 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6003 signo
= XINT (sigcode
);
6009 CHECK_SYMBOL (sigcode
);
6010 name
= SSDATA (SYMBOL_NAME (sigcode
));
6012 signo
= abbr_to_signal (name
);
6014 error ("Undefined signal name %s", name
);
6017 return make_number (kill (pid
, signo
));
6020 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6021 doc
: /* Make PROCESS see end-of-file in its input.
6022 EOF comes after any text already sent to it.
6023 PROCESS may be a process, a buffer, the name of a process or buffer, or
6024 nil, indicating the current buffer's process.
6025 If PROCESS is a network connection, or is a process communicating
6026 through a pipe (as opposed to a pty), then you cannot send any more
6027 text to PROCESS after you call this function.
6028 If PROCESS is a serial process, wait until all output written to the
6029 process has been transmitted to the serial port. */)
6030 (Lisp_Object process
)
6033 struct coding_system
*coding
;
6035 if (DATAGRAM_CONN_P (process
))
6038 proc
= get_process (process
);
6039 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6041 /* Make sure the process is really alive. */
6042 if (XPROCESS (proc
)->raw_status_new
)
6043 update_status (XPROCESS (proc
));
6044 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6045 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6047 if (CODING_REQUIRE_FLUSHING (coding
))
6049 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6050 send_process (proc
, "", 0, Qnil
);
6053 if (XPROCESS (proc
)->pty_flag
)
6054 send_process (proc
, "\004", 1, Qnil
);
6055 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6058 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6059 report_file_error ("Failed tcdrain", Qnil
);
6060 #endif /* not WINDOWSNT */
6061 /* Do nothing on Windows because writes are blocking. */
6065 int old_outfd
= XPROCESS (proc
)->outfd
;
6068 #ifdef HAVE_SHUTDOWN
6069 /* If this is a network connection, or socketpair is used
6070 for communication with the subprocess, call shutdown to cause EOF.
6071 (In some old system, shutdown to socketpair doesn't work.
6072 Then we just can't win.) */
6073 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6074 || XPROCESS (proc
)->infd
== old_outfd
)
6075 shutdown (old_outfd
, 1);
6077 close_process_fd (&XPROCESS (proc
)->open_fd
[WRITE_TO_SUBPROCESS
]);
6078 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6080 report_file_error ("Opening null device", Qnil
);
6081 XPROCESS (proc
)->open_fd
[WRITE_TO_SUBPROCESS
] = new_outfd
;
6082 XPROCESS (proc
)->outfd
= new_outfd
;
6084 if (!proc_encode_coding_system
[new_outfd
])
6085 proc_encode_coding_system
[new_outfd
]
6086 = xmalloc (sizeof (struct coding_system
));
6087 *proc_encode_coding_system
[new_outfd
]
6088 = *proc_encode_coding_system
[old_outfd
];
6089 memset (proc_encode_coding_system
[old_outfd
], 0,
6090 sizeof (struct coding_system
));
6095 /* The main Emacs thread records child processes in three places:
6097 - Vprocess_alist, for asynchronous subprocesses, which are child
6098 processes visible to Lisp.
6100 - deleted_pid_list, for child processes invisible to Lisp,
6101 typically because of delete-process. These are recorded so that
6102 the processes can be reaped when they exit, so that the operating
6103 system's process table is not cluttered by zombies.
6105 - the local variable PID in Fcall_process, call_process_cleanup and
6106 call_process_kill, for synchronous subprocesses.
6107 record_unwind_protect is used to make sure this process is not
6108 forgotten: if the user interrupts call-process and the child
6109 process refuses to exit immediately even with two C-g's,
6110 call_process_kill adds PID's contents to deleted_pid_list before
6113 The main Emacs thread invokes waitpid only on child processes that
6114 it creates and that have not been reaped. This avoid races on
6115 platforms such as GTK, where other threads create their own
6116 subprocesses which the main thread should not reap. For example,
6117 if the main thread attempted to reap an already-reaped child, it
6118 might inadvertently reap a GTK-created process that happened to
6119 have the same process ID. */
6121 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6122 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6123 keep track of its own children. GNUstep is similar. */
6125 static void dummy_handler (int sig
) {}
6126 static signal_handler_t
volatile lib_child_handler
;
6128 /* Handle a SIGCHLD signal by looking for known child processes of
6129 Emacs whose status have changed. For each one found, record its
6132 All we do is change the status; we do not run sentinels or print
6133 notifications. That is saved for the next time keyboard input is
6134 done, in order to avoid timing errors.
6136 ** WARNING: this can be called during garbage collection.
6137 Therefore, it must not be fooled by the presence of mark bits in
6140 ** USG WARNING: Although it is not obvious from the documentation
6141 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6142 signal() before executing at least one wait(), otherwise the
6143 handler will be called again, resulting in an infinite loop. The
6144 relevant portion of the documentation reads "SIGCLD signals will be
6145 queued and the signal-catching function will be continually
6146 reentered until the queue is empty". Invoking signal() causes the
6147 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6150 ** Malloc WARNING: This should never call malloc either directly or
6151 indirectly; if it does, that is a bug */
6154 handle_child_signal (int sig
)
6156 Lisp_Object tail
, proc
;
6158 /* Find the process that signaled us, and record its status. */
6160 /* The process can have been deleted by Fdelete_process, or have
6161 been started asynchronously by Fcall_process. */
6162 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6164 bool all_pids_are_fixnums
6165 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
6166 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
6167 Lisp_Object head
= XCAR (tail
);
6172 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
6175 if (INTEGERP (xpid
))
6176 deleted_pid
= XINT (xpid
);
6178 deleted_pid
= XFLOAT_DATA (xpid
);
6179 if (child_status_changed (deleted_pid
, 0, 0))
6181 if (STRINGP (XCDR (head
)))
6182 unlink (SSDATA (XCDR (head
)));
6183 XSETCAR (tail
, Qnil
);
6188 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6189 FOR_EACH_PROCESS (tail
, proc
)
6191 struct Lisp_Process
*p
= XPROCESS (proc
);
6195 && child_status_changed (p
->pid
, &status
, WUNTRACED
| WCONTINUED
))
6197 /* Change the status of the process that was found. */
6198 p
->tick
= ++process_tick
;
6199 p
->raw_status
= status
;
6200 p
->raw_status_new
= 1;
6202 /* If process has terminated, stop waiting for its output. */
6203 if (WIFSIGNALED (status
) || WIFEXITED (status
))
6205 bool clear_desc_flag
= 0;
6208 clear_desc_flag
= 1;
6210 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
6211 if (clear_desc_flag
)
6213 FD_CLR (p
->infd
, &input_wait_mask
);
6214 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6220 lib_child_handler (sig
);
6221 #ifdef NS_IMPL_GNUSTEP
6222 /* NSTask in GNUStep sets its child handler each time it is called.
6223 So we must re-set ours. */
6224 catch_child_signal();
6229 deliver_child_signal (int sig
)
6231 deliver_process_signal (sig
, handle_child_signal
);
6236 exec_sentinel_error_handler (Lisp_Object error_val
)
6238 cmd_error_internal (error_val
, "error in process sentinel: ");
6240 update_echo_area ();
6241 Fsleep_for (make_number (2), Qnil
);
6246 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6248 Lisp_Object sentinel
, odeactivate
;
6249 struct Lisp_Process
*p
= XPROCESS (proc
);
6250 ptrdiff_t count
= SPECPDL_INDEX ();
6251 bool outer_running_asynch_code
= running_asynch_code
;
6252 int waiting
= waiting_for_user_input_p
;
6254 if (inhibit_sentinels
)
6257 /* No need to gcpro these, because all we do with them later
6258 is test them for EQness, and none of them should be a string. */
6259 odeactivate
= Vdeactivate_mark
;
6261 Lisp_Object obuffer
, okeymap
;
6262 XSETBUFFER (obuffer
, current_buffer
);
6263 okeymap
= BVAR (current_buffer
, keymap
);
6266 /* There's no good reason to let sentinels change the current
6267 buffer, and many callers of accept-process-output, sit-for, and
6268 friends don't expect current-buffer to be changed from under them. */
6269 record_unwind_current_buffer ();
6271 sentinel
= p
->sentinel
;
6273 /* Inhibit quit so that random quits don't screw up a running filter. */
6274 specbind (Qinhibit_quit
, Qt
);
6275 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6277 /* In case we get recursively called,
6278 and we already saved the match data nonrecursively,
6279 save the same match data in safely recursive fashion. */
6280 if (outer_running_asynch_code
)
6283 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6284 restore_search_regs ();
6285 record_unwind_save_match_data ();
6286 Fset_match_data (tem
, Qt
);
6289 /* For speed, if a search happens within this code,
6290 save the match data in a special nonrecursive fashion. */
6291 running_asynch_code
= 1;
6293 internal_condition_case_1 (read_process_output_call
,
6294 list3 (sentinel
, proc
, reason
),
6295 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6296 exec_sentinel_error_handler
);
6298 /* If we saved the match data nonrecursively, restore it now. */
6299 restore_search_regs ();
6300 running_asynch_code
= outer_running_asynch_code
;
6302 Vdeactivate_mark
= odeactivate
;
6304 /* Restore waiting_for_user_input_p as it was
6305 when we were called, in case the filter clobbered it. */
6306 waiting_for_user_input_p
= waiting
;
6309 if (! EQ (Fcurrent_buffer (), obuffer
)
6310 || ! EQ (current_buffer
->keymap
, okeymap
))
6312 /* But do it only if the caller is actually going to read events.
6313 Otherwise there's no need to make him wake up, and it could
6314 cause trouble (for example it would make sit_for return). */
6315 if (waiting_for_user_input_p
== -1)
6316 record_asynch_buffer_change ();
6318 unbind_to (count
, Qnil
);
6321 /* Report all recent events of a change in process status
6322 (either run the sentinel or output a message).
6323 This is usually done while Emacs is waiting for keyboard input
6324 but can be done at other times. */
6327 status_notify (struct Lisp_Process
*deleting_process
)
6329 register Lisp_Object proc
;
6330 Lisp_Object tail
, msg
;
6331 struct gcpro gcpro1
, gcpro2
;
6335 /* We need to gcpro tail; if read_process_output calls a filter
6336 which deletes a process and removes the cons to which tail points
6337 from Vprocess_alist, and then causes a GC, tail is an unprotected
6341 /* Set this now, so that if new processes are created by sentinels
6342 that we run, we get called again to handle their status changes. */
6343 update_tick
= process_tick
;
6345 FOR_EACH_PROCESS (tail
, proc
)
6348 register struct Lisp_Process
*p
= XPROCESS (proc
);
6350 if (p
->tick
!= p
->update_tick
)
6352 p
->update_tick
= p
->tick
;
6354 /* If process is still active, read any output that remains. */
6355 while (! EQ (p
->filter
, Qt
)
6356 && ! EQ (p
->status
, Qconnect
)
6357 && ! EQ (p
->status
, Qlisten
)
6358 /* Network or serial process not stopped: */
6359 && ! EQ (p
->command
, Qt
)
6361 && p
!= deleting_process
6362 && read_process_output (proc
, p
->infd
) > 0);
6364 /* Get the text to use for the message. */
6365 if (p
->raw_status_new
)
6367 msg
= status_message (p
);
6369 /* If process is terminated, deactivate it or delete it. */
6371 if (CONSP (p
->status
))
6372 symbol
= XCAR (p
->status
);
6374 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6375 || EQ (symbol
, Qclosed
))
6377 if (delete_exited_processes
)
6378 remove_process (proc
);
6380 deactivate_process (proc
);
6383 /* The actions above may have further incremented p->tick.
6384 So set p->update_tick again so that an error in the sentinel will
6385 not cause this code to be run again. */
6386 p
->update_tick
= p
->tick
;
6387 /* Now output the message suitably. */
6388 exec_sentinel (proc
, msg
);
6392 update_mode_lines
= 24; /* In case buffers use %s in mode-line-format. */
6396 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel
,
6397 Sinternal_default_process_sentinel
, 2, 2, 0,
6398 doc
: /* Function used as default sentinel for processes. */)
6399 (Lisp_Object proc
, Lisp_Object msg
)
6401 Lisp_Object buffer
, symbol
;
6402 struct Lisp_Process
*p
;
6403 CHECK_PROCESS (proc
);
6404 p
= XPROCESS (proc
);
6408 symbol
= XCAR (symbol
);
6410 if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6413 struct buffer
*old
= current_buffer
;
6414 ptrdiff_t opoint
, opoint_byte
;
6415 ptrdiff_t before
, before_byte
;
6417 /* Avoid error if buffer is deleted
6418 (probably that's why the process is dead, too). */
6419 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
6421 Fset_buffer (buffer
);
6423 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
6424 msg
= (code_convert_string_norecord
6425 (msg
, Vlocale_coding_system
, 1));
6428 opoint_byte
= PT_BYTE
;
6429 /* Insert new output into buffer
6430 at the current end-of-output marker,
6431 thus preserving logical ordering of input and output. */
6432 if (XMARKER (p
->mark
)->buffer
)
6433 Fgoto_char (p
->mark
);
6435 SET_PT_BOTH (ZV
, ZV_BYTE
);
6438 before_byte
= PT_BYTE
;
6440 tem
= BVAR (current_buffer
, read_only
);
6441 bset_read_only (current_buffer
, Qnil
);
6442 insert_string ("\nProcess ");
6443 { /* FIXME: temporary kludge. */
6444 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
6445 insert_string (" ");
6447 bset_read_only (current_buffer
, tem
);
6448 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6450 if (opoint
>= before
)
6451 SET_PT_BOTH (opoint
+ (PT
- before
),
6452 opoint_byte
+ (PT_BYTE
- before_byte
));
6454 SET_PT_BOTH (opoint
, opoint_byte
);
6456 set_buffer_internal (old
);
6462 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6463 Sset_process_coding_system
, 1, 3, 0,
6464 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6465 DECODING will be used to decode subprocess output and ENCODING to
6466 encode subprocess input. */)
6467 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6469 register struct Lisp_Process
*p
;
6471 CHECK_PROCESS (process
);
6472 p
= XPROCESS (process
);
6474 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6476 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6477 Fcheck_coding_system (decoding
);
6478 Fcheck_coding_system (encoding
);
6479 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6480 pset_decode_coding_system (p
, decoding
);
6481 pset_encode_coding_system (p
, encoding
);
6482 setup_process_coding_systems (process
);
6487 DEFUN ("process-coding-system",
6488 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6489 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6490 (register Lisp_Object process
)
6492 CHECK_PROCESS (process
);
6493 return Fcons (XPROCESS (process
)->decode_coding_system
,
6494 XPROCESS (process
)->encode_coding_system
);
6497 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6498 Sset_process_filter_multibyte
, 2, 2, 0,
6499 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6500 If FLAG is non-nil, the filter is given multibyte strings.
6501 If FLAG is nil, the filter is given unibyte strings. In this case,
6502 all character code conversion except for end-of-line conversion is
6504 (Lisp_Object process
, Lisp_Object flag
)
6506 register struct Lisp_Process
*p
;
6508 CHECK_PROCESS (process
);
6509 p
= XPROCESS (process
);
6511 pset_decode_coding_system
6512 (p
, raw_text_coding_system (p
->decode_coding_system
));
6513 setup_process_coding_systems (process
);
6518 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6519 Sprocess_filter_multibyte_p
, 1, 1, 0,
6520 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6521 (Lisp_Object process
)
6523 register struct Lisp_Process
*p
;
6524 struct coding_system
*coding
;
6526 CHECK_PROCESS (process
);
6527 p
= XPROCESS (process
);
6528 coding
= proc_decode_coding_system
[p
->infd
];
6529 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6538 add_gpm_wait_descriptor (int desc
)
6540 add_keyboard_wait_descriptor (desc
);
6544 delete_gpm_wait_descriptor (int desc
)
6546 delete_keyboard_wait_descriptor (desc
);
6551 # ifdef USABLE_SIGIO
6553 /* Return true if *MASK has a bit set
6554 that corresponds to one of the keyboard input descriptors. */
6557 keyboard_bit_set (fd_set
*mask
)
6561 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6562 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6563 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6570 #else /* not subprocesses */
6572 /* Defined on msdos.c. */
6573 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
6574 struct timespec
*, void *);
6576 /* Implementation of wait_reading_process_output, assuming that there
6577 are no subprocesses. Used only by the MS-DOS build.
6579 Wait for timeout to elapse and/or keyboard input to be available.
6583 If negative, gobble data immediately available but don't wait for any.
6586 an additional duration to wait, measured in nanoseconds
6587 If TIME_LIMIT is zero, then:
6588 If NSECS == 0, there is no limit.
6589 If NSECS > 0, the timeout consists of NSECS only.
6590 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
6593 0 to ignore keyboard input, or
6594 1 to return when input is available, or
6595 -1 means caller will actually read the input, so don't throw to
6598 see full version for other parameters. We know that wait_proc will
6599 always be NULL, since `subprocesses' isn't defined.
6601 DO_DISPLAY means redisplay should be done to show subprocess
6602 output that arrives.
6604 Return true if we received input from any process. */
6607 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
6609 Lisp_Object wait_for_cell
,
6610 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6613 struct timespec end_time
, timeout
;
6620 else if (TYPE_MAXIMUM (time_t) < time_limit
)
6621 time_limit
= TYPE_MAXIMUM (time_t);
6623 /* What does time_limit really mean? */
6624 if (time_limit
|| nsecs
> 0)
6626 timeout
= make_timespec (time_limit
, nsecs
);
6627 end_time
= timespec_add (current_timespec (), timeout
);
6630 /* Turn off periodic alarms (in case they are in use)
6631 and then turn off any other atimers,
6632 because the select emulator uses alarms. */
6634 turn_on_atimers (0);
6638 bool timeout_reduced_for_timers
= 0;
6639 fd_set waitchannels
;
6642 /* If calling from keyboard input, do not quit
6643 since we want to return C-g as an input character.
6644 Otherwise, do pending quit if requested. */
6648 /* Exit now if the cell we're waiting for became non-nil. */
6649 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6652 /* Compute time from now till when time limit is up. */
6653 /* Exit if already run out. */
6656 /* A negative timeout means
6657 gobble output available now
6658 but don't wait at all. */
6660 timeout
= make_timespec (0, 0);
6662 else if (time_limit
|| nsecs
> 0)
6664 struct timespec now
= current_timespec ();
6665 if (timespec_cmp (end_time
, now
) <= 0)
6667 timeout
= timespec_sub (end_time
, now
);
6671 timeout
= make_timespec (100000, 0);
6674 /* If our caller will not immediately handle keyboard events,
6675 run timer events directly.
6676 (Callers that will immediately read keyboard events
6677 call timer_delay on their own.) */
6678 if (NILP (wait_for_cell
))
6680 struct timespec timer_delay
;
6684 unsigned old_timers_run
= timers_run
;
6685 timer_delay
= timer_check ();
6686 if (timers_run
!= old_timers_run
&& do_display
)
6687 /* We must retry, since a timer may have requeued itself
6688 and that could alter the time delay. */
6689 redisplay_preserve_echo_area (14);
6693 while (!detect_input_pending ());
6695 /* If there is unread keyboard input, also return. */
6697 && requeued_events_pending_p ())
6700 if (timespec_valid_p (timer_delay
) && nsecs
>= 0)
6702 if (timespec_cmp (timer_delay
, timeout
) < 0)
6704 timeout
= timer_delay
;
6705 timeout_reduced_for_timers
= 1;
6710 /* Cause C-g and alarm signals to take immediate action,
6711 and cause input available signals to zero out timeout. */
6713 set_waiting_for_input (&timeout
);
6715 /* If a frame has been newly mapped and needs updating,
6716 reprocess its display stuff. */
6717 if (frame_garbaged
&& do_display
)
6719 clear_waiting_for_input ();
6720 redisplay_preserve_echo_area (15);
6722 set_waiting_for_input (&timeout
);
6725 /* Wait till there is something to do. */
6726 FD_ZERO (&waitchannels
);
6727 if (read_kbd
&& detect_input_pending ())
6731 if (read_kbd
|| !NILP (wait_for_cell
))
6732 FD_SET (0, &waitchannels
);
6733 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
6738 /* Make C-g and alarm signals set flags again */
6739 clear_waiting_for_input ();
6741 /* If we woke up due to SIGWINCH, actually change size now. */
6742 do_pending_window_change (0);
6744 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
6745 /* We waited the full specified time, so return now. */
6750 /* If the system call was interrupted, then go around the
6752 if (xerrno
== EINTR
)
6753 FD_ZERO (&waitchannels
);
6755 report_file_errno ("Failed select", Qnil
, xerrno
);
6758 /* Check for keyboard input */
6761 && detect_input_pending_run_timers (do_display
))
6763 swallow_events (do_display
);
6764 if (detect_input_pending_run_timers (do_display
))
6768 /* If there is unread keyboard input, also return. */
6770 && requeued_events_pending_p ())
6773 /* If wait_for_cell. check for keyboard input
6774 but don't run any timers.
6775 ??? (It seems wrong to me to check for keyboard
6776 input at all when wait_for_cell, but the code
6777 has been this way since July 1994.
6778 Try changing this after version 19.31.) */
6779 if (! NILP (wait_for_cell
)
6780 && detect_input_pending ())
6782 swallow_events (do_display
);
6783 if (detect_input_pending ())
6787 /* Exit now if the cell we're waiting for became non-nil. */
6788 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6797 #endif /* not subprocesses */
6799 /* The following functions are needed even if async subprocesses are
6800 not supported. Some of them are no-op stubs in that case. */
6802 /* Add DESC to the set of keyboard input descriptors. */
6805 add_keyboard_wait_descriptor (int desc
)
6807 #ifdef subprocesses /* actually means "not MSDOS" */
6808 FD_SET (desc
, &input_wait_mask
);
6809 FD_SET (desc
, &non_process_wait_mask
);
6810 if (desc
> max_input_desc
)
6811 max_input_desc
= desc
;
6815 /* From now on, do not expect DESC to give keyboard input. */
6818 delete_keyboard_wait_descriptor (int desc
)
6821 FD_CLR (desc
, &input_wait_mask
);
6822 FD_CLR (desc
, &non_process_wait_mask
);
6823 delete_input_desc (desc
);
6827 /* Setup coding systems of PROCESS. */
6830 setup_process_coding_systems (Lisp_Object process
)
6833 struct Lisp_Process
*p
= XPROCESS (process
);
6835 int outch
= p
->outfd
;
6836 Lisp_Object coding_system
;
6838 if (inch
< 0 || outch
< 0)
6841 if (!proc_decode_coding_system
[inch
])
6842 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
6843 coding_system
= p
->decode_coding_system
;
6844 if (EQ (p
->filter
, Qinternal_default_process_filter
)
6845 && BUFFERP (p
->buffer
))
6847 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
6848 coding_system
= raw_text_coding_system (coding_system
);
6850 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
6852 if (!proc_encode_coding_system
[outch
])
6853 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
6854 setup_coding_system (p
->encode_coding_system
,
6855 proc_encode_coding_system
[outch
]);
6859 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6860 doc
: /* Return the (or a) process associated with BUFFER.
6861 BUFFER may be a buffer or the name of one. */)
6862 (register Lisp_Object buffer
)
6865 register Lisp_Object buf
, tail
, proc
;
6867 if (NILP (buffer
)) return Qnil
;
6868 buf
= Fget_buffer (buffer
);
6869 if (NILP (buf
)) return Qnil
;
6871 FOR_EACH_PROCESS (tail
, proc
)
6872 if (EQ (XPROCESS (proc
)->buffer
, buf
))
6874 #endif /* subprocesses */
6878 DEFUN ("process-inherit-coding-system-flag",
6879 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6881 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
6882 If this flag is t, `buffer-file-coding-system' of the buffer
6883 associated with PROCESS will inherit the coding system used to decode
6884 the process output. */)
6885 (register Lisp_Object process
)
6888 CHECK_PROCESS (process
);
6889 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
6891 /* Ignore the argument and return the value of
6892 inherit-process-coding-system. */
6893 return inherit_process_coding_system
? Qt
: Qnil
;
6897 /* Kill all processes associated with `buffer'.
6898 If `buffer' is nil, kill all processes */
6901 kill_buffer_processes (Lisp_Object buffer
)
6904 Lisp_Object tail
, proc
;
6906 FOR_EACH_PROCESS (tail
, proc
)
6907 if (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
))
6909 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
6910 Fdelete_process (proc
);
6911 else if (XPROCESS (proc
)->infd
>= 0)
6912 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6914 #else /* subprocesses */
6915 /* Since we have no subprocesses, this does nothing. */
6916 #endif /* subprocesses */
6919 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
6920 Swaiting_for_user_input_p
, 0, 0, 0,
6921 doc
: /* Return non-nil if Emacs is waiting for input from the user.
6922 This is intended for use by asynchronous process output filters and sentinels. */)
6926 return (waiting_for_user_input_p
? Qt
: Qnil
);
6932 /* Stop reading input from keyboard sources. */
6935 hold_keyboard_input (void)
6940 /* Resume reading input from keyboard sources. */
6943 unhold_keyboard_input (void)
6948 /* Return true if keyboard input is on hold, zero otherwise. */
6951 kbd_on_hold_p (void)
6953 return kbd_is_on_hold
;
6957 /* Enumeration of and access to system processes a-la ps(1). */
6959 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
6961 doc
: /* Return a list of numerical process IDs of all running processes.
6962 If this functionality is unsupported, return nil.
6964 See `process-attributes' for getting attributes of a process given its ID. */)
6967 return list_system_processes ();
6970 DEFUN ("process-attributes", Fprocess_attributes
,
6971 Sprocess_attributes
, 1, 1, 0,
6972 doc
: /* Return attributes of the process given by its PID, a number.
6974 Value is an alist where each element is a cons cell of the form
6978 If this functionality is unsupported, the value is nil.
6980 See `list-system-processes' for getting a list of all process IDs.
6982 The KEYs of the attributes that this function may return are listed
6983 below, together with the type of the associated VALUE (in parentheses).
6984 Not all platforms support all of these attributes; unsupported
6985 attributes will not appear in the returned alist.
6986 Unless explicitly indicated otherwise, numbers can have either
6987 integer or floating point values.
6989 euid -- Effective user User ID of the process (number)
6990 user -- User name corresponding to euid (string)
6991 egid -- Effective user Group ID of the process (number)
6992 group -- Group name corresponding to egid (string)
6993 comm -- Command name (executable name only) (string)
6994 state -- Process state code, such as "S", "R", or "T" (string)
6995 ppid -- Parent process ID (number)
6996 pgrp -- Process group ID (number)
6997 sess -- Session ID, i.e. process ID of session leader (number)
6998 ttname -- Controlling tty name (string)
6999 tpgid -- ID of foreground process group on the process's tty (number)
7000 minflt -- number of minor page faults (number)
7001 majflt -- number of major page faults (number)
7002 cminflt -- cumulative number of minor page faults (number)
7003 cmajflt -- cumulative number of major page faults (number)
7004 utime -- user time used by the process, in (current-time) format,
7005 which is a list of integers (HIGH LOW USEC PSEC)
7006 stime -- system time used by the process (current-time)
7007 time -- sum of utime and stime (current-time)
7008 cutime -- user time used by the process and its children (current-time)
7009 cstime -- system time used by the process and its children (current-time)
7010 ctime -- sum of cutime and cstime (current-time)
7011 pri -- priority of the process (number)
7012 nice -- nice value of the process (number)
7013 thcount -- process thread count (number)
7014 start -- time the process started (current-time)
7015 vsize -- virtual memory size of the process in KB's (number)
7016 rss -- resident set size of the process in KB's (number)
7017 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7018 pcpu -- percents of CPU time used by the process (floating-point number)
7019 pmem -- percents of total physical memory used by process's resident set
7020 (floating-point number)
7021 args -- command line which invoked the process (string). */)
7024 return system_process_attributes (pid
);
7027 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7028 Invoke this after init_process_emacs, and after glib and/or GNUstep
7029 futz with the SIGCHLD handler, but before Emacs forks any children.
7030 This function's caller should block SIGCHLD. */
7032 #ifndef NS_IMPL_GNUSTEP
7036 catch_child_signal (void)
7038 struct sigaction action
, old_action
;
7039 emacs_sigaction_init (&action
, deliver_child_signal
);
7040 block_child_signal ();
7041 sigaction (SIGCHLD
, &action
, &old_action
);
7042 eassert (! (old_action
.sa_flags
& SA_SIGINFO
));
7044 if (old_action
.sa_handler
!= deliver_child_signal
)
7046 = (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7048 : old_action
.sa_handler
);
7049 unblock_child_signal ();
7053 /* This is not called "init_process" because that is the name of a
7054 Mach system call, so it would cause problems on Darwin systems. */
7056 init_process_emacs (void)
7061 inhibit_sentinels
= 0;
7064 if (! noninteractive
|| initialized
)
7067 #if defined HAVE_GLIB && !defined WINDOWSNT
7068 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7069 this should always fail, but is enough to initialize glib's
7070 private SIGCHLD handler, allowing catch_child_signal to copy
7071 it into lib_child_handler. */
7072 g_source_unref (g_child_watch_source_new (getpid ()));
7074 catch_child_signal ();
7077 FD_ZERO (&input_wait_mask
);
7078 FD_ZERO (&non_keyboard_wait_mask
);
7079 FD_ZERO (&non_process_wait_mask
);
7080 FD_ZERO (&write_mask
);
7081 max_process_desc
= max_input_desc
= -1;
7082 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7084 #ifdef NON_BLOCKING_CONNECT
7085 FD_ZERO (&connect_wait_mask
);
7086 num_pending_connects
= 0;
7089 #ifdef ADAPTIVE_READ_BUFFERING
7090 process_output_delay_count
= 0;
7091 process_output_skip
= 0;
7094 /* Don't do this, it caused infinite select loops. The display
7095 method should call add_keyboard_wait_descriptor on stdin if it
7098 FD_SET (0, &input_wait_mask
);
7101 Vprocess_alist
= Qnil
;
7102 deleted_pid_list
= Qnil
;
7103 for (i
= 0; i
< FD_SETSIZE
; i
++)
7105 chan_process
[i
] = Qnil
;
7106 proc_buffered_char
[i
] = -1;
7108 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7109 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7110 #ifdef DATAGRAM_SOCKETS
7111 memset (datagram_address
, 0, sizeof datagram_address
);
7115 Lisp_Object subfeatures
= Qnil
;
7116 const struct socket_options
*sopt
;
7118 #define ADD_SUBFEATURE(key, val) \
7119 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7121 #ifdef NON_BLOCKING_CONNECT
7122 ADD_SUBFEATURE (QCnowait
, Qt
);
7124 #ifdef DATAGRAM_SOCKETS
7125 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7127 #ifdef HAVE_SEQPACKET
7128 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7130 #ifdef HAVE_LOCAL_SOCKETS
7131 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7133 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7135 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7137 #ifdef HAVE_GETSOCKNAME
7138 ADD_SUBFEATURE (QCservice
, Qt
);
7140 ADD_SUBFEATURE (QCserver
, Qt
);
7142 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7143 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7145 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7148 #if defined (DARWIN_OS)
7149 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7150 processes. As such, we only change the default value. */
7153 char const *release
= (STRINGP (Voperating_system_release
)
7154 ? SSDATA (Voperating_system_release
)
7156 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
7157 Vprocess_connection_type
= Qnil
;
7161 #endif /* subprocesses */
7166 syms_of_process (void)
7170 DEFSYM (Qprocessp
, "processp");
7171 DEFSYM (Qrun
, "run");
7172 DEFSYM (Qstop
, "stop");
7173 DEFSYM (Qsignal
, "signal");
7175 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7178 Qexit = intern_c_string ("exit");
7179 staticpro (&Qexit); */
7181 DEFSYM (Qopen
, "open");
7182 DEFSYM (Qclosed
, "closed");
7183 DEFSYM (Qconnect
, "connect");
7184 DEFSYM (Qfailed
, "failed");
7185 DEFSYM (Qlisten
, "listen");
7186 DEFSYM (Qlocal
, "local");
7187 DEFSYM (Qipv4
, "ipv4");
7189 DEFSYM (Qipv6
, "ipv6");
7191 DEFSYM (Qdatagram
, "datagram");
7192 DEFSYM (Qseqpacket
, "seqpacket");
7194 DEFSYM (QCport
, ":port");
7195 DEFSYM (QCspeed
, ":speed");
7196 DEFSYM (QCprocess
, ":process");
7198 DEFSYM (QCbytesize
, ":bytesize");
7199 DEFSYM (QCstopbits
, ":stopbits");
7200 DEFSYM (QCparity
, ":parity");
7201 DEFSYM (Qodd
, "odd");
7202 DEFSYM (Qeven
, "even");
7203 DEFSYM (QCflowcontrol
, ":flowcontrol");
7206 DEFSYM (QCsummary
, ":summary");
7208 DEFSYM (Qreal
, "real");
7209 DEFSYM (Qnetwork
, "network");
7210 DEFSYM (Qserial
, "serial");
7211 DEFSYM (QCbuffer
, ":buffer");
7212 DEFSYM (QChost
, ":host");
7213 DEFSYM (QCservice
, ":service");
7214 DEFSYM (QClocal
, ":local");
7215 DEFSYM (QCremote
, ":remote");
7216 DEFSYM (QCcoding
, ":coding");
7217 DEFSYM (QCserver
, ":server");
7218 DEFSYM (QCnowait
, ":nowait");
7219 DEFSYM (QCsentinel
, ":sentinel");
7220 DEFSYM (QClog
, ":log");
7221 DEFSYM (QCnoquery
, ":noquery");
7222 DEFSYM (QCstop
, ":stop");
7223 DEFSYM (QCoptions
, ":options");
7224 DEFSYM (QCplist
, ":plist");
7226 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
7228 staticpro (&Vprocess_alist
);
7229 staticpro (&deleted_pid_list
);
7231 #endif /* subprocesses */
7233 DEFSYM (QCname
, ":name");
7234 DEFSYM (QCtype
, ":type");
7236 DEFSYM (Qeuid
, "euid");
7237 DEFSYM (Qegid
, "egid");
7238 DEFSYM (Quser
, "user");
7239 DEFSYM (Qgroup
, "group");
7240 DEFSYM (Qcomm
, "comm");
7241 DEFSYM (Qstate
, "state");
7242 DEFSYM (Qppid
, "ppid");
7243 DEFSYM (Qpgrp
, "pgrp");
7244 DEFSYM (Qsess
, "sess");
7245 DEFSYM (Qttname
, "ttname");
7246 DEFSYM (Qtpgid
, "tpgid");
7247 DEFSYM (Qminflt
, "minflt");
7248 DEFSYM (Qmajflt
, "majflt");
7249 DEFSYM (Qcminflt
, "cminflt");
7250 DEFSYM (Qcmajflt
, "cmajflt");
7251 DEFSYM (Qutime
, "utime");
7252 DEFSYM (Qstime
, "stime");
7253 DEFSYM (Qtime
, "time");
7254 DEFSYM (Qcutime
, "cutime");
7255 DEFSYM (Qcstime
, "cstime");
7256 DEFSYM (Qctime
, "ctime");
7257 DEFSYM (Qinternal_default_process_sentinel
,
7258 "internal-default-process-sentinel");
7259 DEFSYM (Qinternal_default_process_filter
,
7260 "internal-default-process-filter");
7261 DEFSYM (Qpri
, "pri");
7262 DEFSYM (Qnice
, "nice");
7263 DEFSYM (Qthcount
, "thcount");
7264 DEFSYM (Qstart
, "start");
7265 DEFSYM (Qvsize
, "vsize");
7266 DEFSYM (Qrss
, "rss");
7267 DEFSYM (Qetime
, "etime");
7268 DEFSYM (Qpcpu
, "pcpu");
7269 DEFSYM (Qpmem
, "pmem");
7270 DEFSYM (Qargs
, "args");
7272 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7273 doc
: /* Non-nil means delete processes immediately when they exit.
7274 A value of nil means don't delete them until `list-processes' is run. */);
7276 delete_exited_processes
= 1;
7279 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7280 doc
: /* Control type of device used to communicate with subprocesses.
7281 Values are nil to use a pipe, or t or `pty' to use a pty.
7282 The value has no effect if the system has no ptys or if all ptys are busy:
7283 then a pipe is used in any case.
7284 The value takes effect when `start-process' is called. */);
7285 Vprocess_connection_type
= Qt
;
7287 #ifdef ADAPTIVE_READ_BUFFERING
7288 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7289 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7290 On some systems, when Emacs reads the output from a subprocess, the output data
7291 is read in very small blocks, potentially resulting in very poor performance.
7292 This behavior can be remedied to some extent by setting this variable to a
7293 non-nil value, as it will automatically delay reading from such processes, to
7294 allow them to produce more output before Emacs tries to read it.
7295 If the value is t, the delay is reset after each write to the process; any other
7296 non-nil value means that the delay is not reset on write.
7297 The variable takes effect when `start-process' is called. */);
7298 Vprocess_adaptive_read_buffering
= Qt
;
7301 defsubr (&Sprocessp
);
7302 defsubr (&Sget_process
);
7303 defsubr (&Sdelete_process
);
7304 defsubr (&Sprocess_status
);
7305 defsubr (&Sprocess_exit_status
);
7306 defsubr (&Sprocess_id
);
7307 defsubr (&Sprocess_name
);
7308 defsubr (&Sprocess_tty_name
);
7309 defsubr (&Sprocess_command
);
7310 defsubr (&Sset_process_buffer
);
7311 defsubr (&Sprocess_buffer
);
7312 defsubr (&Sprocess_mark
);
7313 defsubr (&Sset_process_filter
);
7314 defsubr (&Sprocess_filter
);
7315 defsubr (&Sset_process_sentinel
);
7316 defsubr (&Sprocess_sentinel
);
7317 defsubr (&Sset_process_window_size
);
7318 defsubr (&Sset_process_inherit_coding_system_flag
);
7319 defsubr (&Sset_process_query_on_exit_flag
);
7320 defsubr (&Sprocess_query_on_exit_flag
);
7321 defsubr (&Sprocess_contact
);
7322 defsubr (&Sprocess_plist
);
7323 defsubr (&Sset_process_plist
);
7324 defsubr (&Sprocess_list
);
7325 defsubr (&Sstart_process
);
7326 defsubr (&Sserial_process_configure
);
7327 defsubr (&Smake_serial_process
);
7328 defsubr (&Sset_network_process_option
);
7329 defsubr (&Smake_network_process
);
7330 defsubr (&Sformat_network_address
);
7331 defsubr (&Snetwork_interface_list
);
7332 defsubr (&Snetwork_interface_info
);
7333 #ifdef DATAGRAM_SOCKETS
7334 defsubr (&Sprocess_datagram_address
);
7335 defsubr (&Sset_process_datagram_address
);
7337 defsubr (&Saccept_process_output
);
7338 defsubr (&Sprocess_send_region
);
7339 defsubr (&Sprocess_send_string
);
7340 defsubr (&Sinterrupt_process
);
7341 defsubr (&Skill_process
);
7342 defsubr (&Squit_process
);
7343 defsubr (&Sstop_process
);
7344 defsubr (&Scontinue_process
);
7345 defsubr (&Sprocess_running_child_p
);
7346 defsubr (&Sprocess_send_eof
);
7347 defsubr (&Ssignal_process
);
7348 defsubr (&Swaiting_for_user_input_p
);
7349 defsubr (&Sprocess_type
);
7350 defsubr (&Sinternal_default_process_sentinel
);
7351 defsubr (&Sinternal_default_process_filter
);
7352 defsubr (&Sset_process_coding_system
);
7353 defsubr (&Sprocess_coding_system
);
7354 defsubr (&Sset_process_filter_multibyte
);
7355 defsubr (&Sprocess_filter_multibyte_p
);
7357 #endif /* subprocesses */
7359 defsubr (&Sget_buffer_process
);
7360 defsubr (&Sprocess_inherit_coding_system_flag
);
7361 defsubr (&Slist_system_processes
);
7362 defsubr (&Sprocess_attributes
);