* fileio.c (Finsert_file_contents): Avoid double-close.
[emacs.git] / src / process.c
blob34783fae5fdd7129a10547c528e4bc2910343a57
1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2013 Free Software
4 Foundation, Inc.
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/>. */
22 #include <config.h>
24 #define PROCESS_INLINE EXTERN_INLINE
26 #include <stdio.h>
27 #include <errno.h>
28 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
29 #include <sys/file.h>
30 #include <sys/stat.h>
31 #include <unistd.h>
32 #include <fcntl.h>
34 #include "lisp.h"
36 /* Only MS-DOS does not define `subprocesses'. */
37 #ifdef subprocesses
39 #include <sys/socket.h>
40 #include <netdb.h>
41 #include <netinet/in.h>
42 #include <arpa/inet.h>
44 /* Are local (unix) sockets supported? */
45 #if defined (HAVE_SYS_UN_H)
46 #if !defined (AF_LOCAL) && defined (AF_UNIX)
47 #define AF_LOCAL AF_UNIX
48 #endif
49 #ifdef AF_LOCAL
50 #define HAVE_LOCAL_SOCKETS
51 #include <sys/un.h>
52 #endif
53 #endif
55 #include <sys/ioctl.h>
56 #if defined (HAVE_NET_IF_H)
57 #include <net/if.h>
58 #endif /* HAVE_NET_IF_H */
60 #if defined (HAVE_IFADDRS_H)
61 /* Must be after net/if.h */
62 #include <ifaddrs.h>
64 /* We only use structs from this header when we use getifaddrs. */
65 #if defined (HAVE_NET_IF_DL_H)
66 #include <net/if_dl.h>
67 #endif
69 #endif
71 #ifdef NEED_BSDTTY
72 #include <bsdtty.h>
73 #endif
75 #ifdef USG5_4
76 # include <sys/stream.h>
77 # include <sys/stropts.h>
78 #endif
80 #ifdef HAVE_RES_INIT
81 #include <arpa/nameser.h>
82 #include <resolv.h>
83 #endif
85 #ifdef HAVE_UTIL_H
86 #include <util.h>
87 #endif
89 #ifdef HAVE_PTY_H
90 #include <pty.h>
91 #endif
93 #include <c-ctype.h>
94 #include <sig2str.h>
96 #endif /* subprocesses */
98 #include "systime.h"
99 #include "systty.h"
101 #include "window.h"
102 #include "character.h"
103 #include "buffer.h"
104 #include "coding.h"
105 #include "process.h"
106 #include "frame.h"
107 #include "termhooks.h"
108 #include "termopts.h"
109 #include "commands.h"
110 #include "keyboard.h"
111 #include "blockinput.h"
112 #include "dispextern.h"
113 #include "composite.h"
114 #include "atimer.h"
115 #include "sysselect.h"
116 #include "syssignal.h"
117 #include "syswait.h"
118 #ifdef HAVE_GNUTLS
119 #include "gnutls.h"
120 #endif
122 #ifdef HAVE_WINDOW_SYSTEM
123 #include TERM_HEADER
124 #endif /* HAVE_WINDOW_SYSTEM */
126 #ifdef HAVE_GLIB
127 #include "xgselect.h"
128 #ifndef WINDOWSNT
129 #include <glib.h>
130 #endif
131 #endif
133 #ifdef WINDOWSNT
134 extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
135 EMACS_TIME *, void *);
136 #endif
138 #ifndef SOCK_CLOEXEC
139 # define SOCK_CLOEXEC 0
140 #endif
142 #ifndef HAVE_ACCEPT4
144 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
146 static int
147 close_on_exec (int fd)
149 if (0 <= fd)
150 fcntl (fd, F_SETFD, FD_CLOEXEC);
151 return fd;
154 static int
155 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
157 return close_on_exec (accept (sockfd, addr, addrlen));
160 static int
161 process_socket (int domain, int type, int protocol)
163 return close_on_exec (socket (domain, type, protocol));
165 # undef socket
166 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
167 #endif
169 /* Work around GCC 4.7.0 bug with strict overflow checking; see
170 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
171 These lines can be removed once the GCC bug is fixed. */
172 #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
173 # pragma GCC diagnostic ignored "-Wstrict-overflow"
174 #endif
176 Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
177 Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
178 Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
179 Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
180 Lisp_Object QCname, QCtype;
182 /* True if keyboard input is on hold, zero otherwise. */
184 static bool kbd_is_on_hold;
186 /* Nonzero means don't run process sentinels. This is used
187 when exiting. */
188 bool inhibit_sentinels;
190 #ifdef subprocesses
192 Lisp_Object Qprocessp;
193 static Lisp_Object Qrun, Qstop, Qsignal;
194 static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
195 Lisp_Object Qlocal;
196 static Lisp_Object Qipv4, Qdatagram, Qseqpacket;
197 static Lisp_Object Qreal, Qnetwork, Qserial;
198 #ifdef AF_INET6
199 static Lisp_Object Qipv6;
200 #endif
201 static Lisp_Object QCport, QCprocess;
202 Lisp_Object QCspeed;
203 Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
204 Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
205 static Lisp_Object QCbuffer, QChost, QCservice;
206 static Lisp_Object QClocal, QCremote, QCcoding;
207 static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
208 static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
209 static Lisp_Object Qlast_nonmenu_event;
210 static Lisp_Object Qinternal_default_process_sentinel;
211 static Lisp_Object Qinternal_default_process_filter;
213 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
214 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
215 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
216 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
218 /* Number of events of change of status of a process. */
219 static EMACS_INT process_tick;
220 /* Number of events for which the user or sentinel has been notified. */
221 static EMACS_INT update_tick;
223 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
225 /* Only W32 has this, it really means that select can't take write mask. */
226 #ifdef BROKEN_NON_BLOCKING_CONNECT
227 #undef NON_BLOCKING_CONNECT
228 #define SELECT_CANT_DO_WRITE_MASK
229 #else
230 #ifndef NON_BLOCKING_CONNECT
231 #ifdef HAVE_SELECT
232 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
233 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
234 #define NON_BLOCKING_CONNECT
235 #endif /* EWOULDBLOCK || EINPROGRESS */
236 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
237 #endif /* HAVE_SELECT */
238 #endif /* NON_BLOCKING_CONNECT */
239 #endif /* BROKEN_NON_BLOCKING_CONNECT */
241 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
242 this system. We need to read full packets, so we need a
243 "non-destructive" select. So we require either native select,
244 or emulation of select using FIONREAD. */
246 #ifndef BROKEN_DATAGRAM_SOCKETS
247 # if defined HAVE_SELECT || defined USABLE_FIONREAD
248 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
249 # define DATAGRAM_SOCKETS
250 # endif
251 # endif
252 #endif
254 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
255 # define HAVE_SEQPACKET
256 #endif
258 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
259 #define ADAPTIVE_READ_BUFFERING
260 #endif
262 #ifdef ADAPTIVE_READ_BUFFERING
263 #define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
264 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
265 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
267 /* Number of processes which have a non-zero read_output_delay,
268 and therefore might be delayed for adaptive read buffering. */
270 static int process_output_delay_count;
272 /* True if any process has non-nil read_output_skip. */
274 static bool process_output_skip;
276 #else
277 #define process_output_delay_count 0
278 #endif
280 static void create_process (Lisp_Object, char **, Lisp_Object);
281 #ifdef USABLE_SIGIO
282 static bool keyboard_bit_set (SELECT_TYPE *);
283 #endif
284 static void deactivate_process (Lisp_Object);
285 static void status_notify (struct Lisp_Process *);
286 static int read_process_output (Lisp_Object, int);
287 static void handle_child_signal (int);
288 static void create_pty (Lisp_Object);
290 /* If we support a window system, turn on the code to poll periodically
291 to detect C-g. It isn't actually used when doing interrupt input. */
292 #ifdef HAVE_WINDOW_SYSTEM
293 #define POLL_FOR_INPUT
294 #endif
296 static Lisp_Object get_process (register Lisp_Object name);
297 static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
299 /* Mask of bits indicating the descriptors that we wait for input on. */
301 static SELECT_TYPE input_wait_mask;
303 /* Mask that excludes keyboard input descriptor(s). */
305 static SELECT_TYPE non_keyboard_wait_mask;
307 /* Mask that excludes process input descriptor(s). */
309 static SELECT_TYPE non_process_wait_mask;
311 /* Mask for selecting for write. */
313 static SELECT_TYPE write_mask;
315 #ifdef NON_BLOCKING_CONNECT
316 /* Mask of bits indicating the descriptors that we wait for connect to
317 complete on. Once they complete, they are removed from this mask
318 and added to the input_wait_mask and non_keyboard_wait_mask. */
320 static SELECT_TYPE connect_wait_mask;
322 /* Number of bits set in connect_wait_mask. */
323 static int num_pending_connects;
324 #endif /* NON_BLOCKING_CONNECT */
326 /* The largest descriptor currently in use for a process object. */
327 static int max_process_desc;
329 /* The largest descriptor currently in use for input. */
330 static int max_input_desc;
332 /* Indexed by descriptor, gives the process (if any) for that descriptor */
333 static Lisp_Object chan_process[MAXDESC];
335 /* Alist of elements (NAME . PROCESS) */
336 static Lisp_Object Vprocess_alist;
338 /* Buffered-ahead input char from process, indexed by channel.
339 -1 means empty (no char is buffered).
340 Used on sys V where the only way to tell if there is any
341 output from the process is to read at least one char.
342 Always -1 on systems that support FIONREAD. */
344 static int proc_buffered_char[MAXDESC];
346 /* Table of `struct coding-system' for each process. */
347 static struct coding_system *proc_decode_coding_system[MAXDESC];
348 static struct coding_system *proc_encode_coding_system[MAXDESC];
350 #ifdef DATAGRAM_SOCKETS
351 /* Table of `partner address' for datagram sockets. */
352 static struct sockaddr_and_len {
353 struct sockaddr *sa;
354 int len;
355 } datagram_address[MAXDESC];
356 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
357 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
358 #else
359 #define DATAGRAM_CHAN_P(chan) (0)
360 #define DATAGRAM_CONN_P(proc) (0)
361 #endif
363 /* These setters are used only in this file, so they can be private. */
364 static void
365 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
367 p->buffer = val;
369 static void
370 pset_command (struct Lisp_Process *p, Lisp_Object val)
372 p->command = val;
374 static void
375 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
377 p->decode_coding_system = val;
379 static void
380 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
382 p->decoding_buf = val;
384 static void
385 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
387 p->encode_coding_system = val;
389 static void
390 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
392 p->encoding_buf = val;
394 static void
395 pset_filter (struct Lisp_Process *p, Lisp_Object val)
397 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
399 static void
400 pset_log (struct Lisp_Process *p, Lisp_Object val)
402 p->log = val;
404 static void
405 pset_mark (struct Lisp_Process *p, Lisp_Object val)
407 p->mark = val;
409 static void
410 pset_name (struct Lisp_Process *p, Lisp_Object val)
412 p->name = val;
414 static void
415 pset_plist (struct Lisp_Process *p, Lisp_Object val)
417 p->plist = val;
419 static void
420 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
422 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
424 static void
425 pset_status (struct Lisp_Process *p, Lisp_Object val)
427 p->status = val;
429 static void
430 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
432 p->tty_name = val;
434 static void
435 pset_type (struct Lisp_Process *p, Lisp_Object val)
437 p->type = val;
439 static void
440 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
442 p->write_queue = val;
447 static struct fd_callback_data
449 fd_callback func;
450 void *data;
451 #define FOR_READ 1
452 #define FOR_WRITE 2
453 int condition; /* mask of the defines above. */
454 } fd_callback_info[MAXDESC];
457 /* Add a file descriptor FD to be monitored for when read is possible.
458 When read is possible, call FUNC with argument DATA. */
460 void
461 add_read_fd (int fd, fd_callback func, void *data)
463 eassert (fd < MAXDESC);
464 add_keyboard_wait_descriptor (fd);
466 fd_callback_info[fd].func = func;
467 fd_callback_info[fd].data = data;
468 fd_callback_info[fd].condition |= FOR_READ;
471 /* Stop monitoring file descriptor FD for when read is possible. */
473 void
474 delete_read_fd (int fd)
476 eassert (fd < MAXDESC);
477 delete_keyboard_wait_descriptor (fd);
479 fd_callback_info[fd].condition &= ~FOR_READ;
480 if (fd_callback_info[fd].condition == 0)
482 fd_callback_info[fd].func = 0;
483 fd_callback_info[fd].data = 0;
487 /* Add a file descriptor FD to be monitored for when write is possible.
488 When write is possible, call FUNC with argument DATA. */
490 void
491 add_write_fd (int fd, fd_callback func, void *data)
493 eassert (fd < MAXDESC);
494 FD_SET (fd, &write_mask);
495 if (fd > max_input_desc)
496 max_input_desc = fd;
498 fd_callback_info[fd].func = func;
499 fd_callback_info[fd].data = data;
500 fd_callback_info[fd].condition |= FOR_WRITE;
503 /* Stop monitoring file descriptor FD for when write is possible. */
505 void
506 delete_write_fd (int fd)
508 int lim = max_input_desc;
510 eassert (fd < MAXDESC);
511 FD_CLR (fd, &write_mask);
512 fd_callback_info[fd].condition &= ~FOR_WRITE;
513 if (fd_callback_info[fd].condition == 0)
515 fd_callback_info[fd].func = 0;
516 fd_callback_info[fd].data = 0;
518 if (fd == max_input_desc)
519 for (fd = lim; fd >= 0; fd--)
520 if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
522 max_input_desc = fd;
523 break;
530 /* Compute the Lisp form of the process status, p->status, from
531 the numeric status that was returned by `wait'. */
533 static Lisp_Object status_convert (int);
535 static void
536 update_status (struct Lisp_Process *p)
538 eassert (p->raw_status_new);
539 pset_status (p, status_convert (p->raw_status));
540 p->raw_status_new = 0;
543 /* Convert a process status word in Unix format to
544 the list that we use internally. */
546 static Lisp_Object
547 status_convert (int w)
549 if (WIFSTOPPED (w))
550 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
551 else if (WIFEXITED (w))
552 return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
553 WCOREDUMP (w) ? Qt : Qnil));
554 else if (WIFSIGNALED (w))
555 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
556 WCOREDUMP (w) ? Qt : Qnil));
557 else
558 return Qrun;
561 /* Given a status-list, extract the three pieces of information
562 and store them individually through the three pointers. */
564 static void
565 decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, bool *coredump)
567 Lisp_Object tem;
569 if (SYMBOLP (l))
571 *symbol = l;
572 *code = 0;
573 *coredump = 0;
575 else
577 *symbol = XCAR (l);
578 tem = XCDR (l);
579 *code = XFASTINT (XCAR (tem));
580 tem = XCDR (tem);
581 *coredump = !NILP (tem);
585 /* Return a string describing a process status list. */
587 static Lisp_Object
588 status_message (struct Lisp_Process *p)
590 Lisp_Object status = p->status;
591 Lisp_Object symbol;
592 int code;
593 bool coredump;
594 Lisp_Object string, string2;
596 decode_status (status, &symbol, &code, &coredump);
598 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
600 char const *signame;
601 synchronize_system_messages_locale ();
602 signame = strsignal (code);
603 if (signame == 0)
604 string = build_string ("unknown");
605 else
607 int c1, c2;
609 string = build_unibyte_string (signame);
610 if (! NILP (Vlocale_coding_system))
611 string = (code_convert_string_norecord
612 (string, Vlocale_coding_system, 0));
613 c1 = STRING_CHAR (SDATA (string));
614 c2 = downcase (c1);
615 if (c1 != c2)
616 Faset (string, make_number (0), make_number (c2));
618 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
619 return concat2 (string, string2);
621 else if (EQ (symbol, Qexit))
623 if (NETCONN1_P (p))
624 return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
625 if (code == 0)
626 return build_string ("finished\n");
627 string = Fnumber_to_string (make_number (code));
628 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
629 return concat3 (build_string ("exited abnormally with code "),
630 string, string2);
632 else if (EQ (symbol, Qfailed))
634 string = Fnumber_to_string (make_number (code));
635 string2 = build_string ("\n");
636 return concat3 (build_string ("failed with code "),
637 string, string2);
639 else
640 return Fcopy_sequence (Fsymbol_name (symbol));
643 enum { PTY_NAME_SIZE = 24 };
645 /* Open an available pty, returning a file descriptor.
646 Store into PTY_NAME the file name of the terminal corresponding to the pty.
647 Return -1 on failure. */
649 static int
650 allocate_pty (char pty_name[PTY_NAME_SIZE])
652 #ifdef HAVE_PTYS
653 int fd;
655 #ifdef PTY_ITERATION
656 PTY_ITERATION
657 #else
658 register int c, i;
659 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
660 for (i = 0; i < 16; i++)
661 #endif
663 #ifdef PTY_NAME_SPRINTF
664 PTY_NAME_SPRINTF
665 #else
666 sprintf (pty_name, "/dev/pty%c%x", c, i);
667 #endif /* no PTY_NAME_SPRINTF */
669 #ifdef PTY_OPEN
670 PTY_OPEN;
671 #else /* no PTY_OPEN */
672 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
673 #endif /* no PTY_OPEN */
675 if (fd >= 0)
677 /* check to make certain that both sides are available
678 this avoids a nasty yet stupid bug in rlogins */
679 #ifdef PTY_TTY_NAME_SPRINTF
680 PTY_TTY_NAME_SPRINTF
681 #else
682 sprintf (pty_name, "/dev/tty%c%x", c, i);
683 #endif /* no PTY_TTY_NAME_SPRINTF */
684 if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
686 emacs_close (fd);
687 # ifndef __sgi
688 continue;
689 # else
690 return -1;
691 # endif /* __sgi */
693 setup_pty (fd);
694 return fd;
697 #endif /* HAVE_PTYS */
698 return -1;
701 static Lisp_Object
702 make_process (Lisp_Object name)
704 register Lisp_Object val, tem, name1;
705 register struct Lisp_Process *p;
706 char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)];
707 printmax_t i;
709 p = allocate_process ();
710 /* Initialize Lisp data. Note that allocate_process initializes all
711 Lisp data to nil, so do it only for slots which should not be nil. */
712 pset_status (p, Qrun);
713 pset_mark (p, Fmake_marker ());
715 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
716 non-Lisp data, so do it only for slots which should not be zero. */
717 p->infd = -1;
718 p->outfd = -1;
720 #ifdef HAVE_GNUTLS
721 p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
722 #endif
724 /* If name is already in use, modify it until it is unused. */
726 name1 = name;
727 for (i = 1; ; i++)
729 tem = Fget_process (name1);
730 if (NILP (tem)) break;
731 name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
733 name = name1;
734 pset_name (p, name);
735 pset_sentinel (p, Qinternal_default_process_sentinel);
736 pset_filter (p, Qinternal_default_process_filter);
737 XSETPROCESS (val, p);
738 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
739 return val;
742 static void
743 remove_process (register Lisp_Object proc)
745 register Lisp_Object pair;
747 pair = Frassq (proc, Vprocess_alist);
748 Vprocess_alist = Fdelq (pair, Vprocess_alist);
750 deactivate_process (proc);
754 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
755 doc: /* Return t if OBJECT is a process. */)
756 (Lisp_Object object)
758 return PROCESSP (object) ? Qt : Qnil;
761 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
762 doc: /* Return the process named NAME, or nil if there is none. */)
763 (register Lisp_Object name)
765 if (PROCESSP (name))
766 return name;
767 CHECK_STRING (name);
768 return Fcdr (Fassoc (name, Vprocess_alist));
771 /* This is how commands for the user decode process arguments. It
772 accepts a process, a process name, a buffer, a buffer name, or nil.
773 Buffers denote the first process in the buffer, and nil denotes the
774 current buffer. */
776 static Lisp_Object
777 get_process (register Lisp_Object name)
779 register Lisp_Object proc, obj;
780 if (STRINGP (name))
782 obj = Fget_process (name);
783 if (NILP (obj))
784 obj = Fget_buffer (name);
785 if (NILP (obj))
786 error ("Process %s does not exist", SDATA (name));
788 else if (NILP (name))
789 obj = Fcurrent_buffer ();
790 else
791 obj = name;
793 /* Now obj should be either a buffer object or a process object.
795 if (BUFFERP (obj))
797 proc = Fget_buffer_process (obj);
798 if (NILP (proc))
799 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
801 else
803 CHECK_PROCESS (obj);
804 proc = obj;
806 return proc;
810 /* Fdelete_process promises to immediately forget about the process, but in
811 reality, Emacs needs to remember those processes until they have been
812 treated by the SIGCHLD handler and waitpid has been invoked on them;
813 otherwise they might fill up the kernel's process table.
815 Some processes created by call-process are also put onto this list. */
816 static Lisp_Object deleted_pid_list;
818 void
819 record_deleted_pid (pid_t pid)
821 deleted_pid_list = Fcons (make_fixnum_or_float (pid),
822 /* GC treated elements set to nil. */
823 Fdelq (Qnil, deleted_pid_list));
827 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
828 doc: /* Delete PROCESS: kill it and forget about it immediately.
829 PROCESS may be a process, a buffer, the name of a process or buffer, or
830 nil, indicating the current buffer's process. */)
831 (register Lisp_Object process)
833 register struct Lisp_Process *p;
835 process = get_process (process);
836 p = XPROCESS (process);
838 p->raw_status_new = 0;
839 if (NETCONN1_P (p) || SERIALCONN1_P (p))
841 pset_status (p, list2 (Qexit, make_number (0)));
842 p->tick = ++process_tick;
843 status_notify (p);
844 redisplay_preserve_echo_area (13);
846 else
848 if (p->alive)
849 record_kill_process (p);
851 if (p->infd >= 0)
853 /* Update P's status, since record_kill_process will make the
854 SIGCHLD handler update deleted_pid_list, not *P. */
855 Lisp_Object symbol;
856 if (p->raw_status_new)
857 update_status (p);
858 symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
859 if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
860 pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
862 p->tick = ++process_tick;
863 status_notify (p);
864 redisplay_preserve_echo_area (13);
867 remove_process (process);
868 return Qnil;
871 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
872 doc: /* Return the status of PROCESS.
873 The returned value is one of the following symbols:
874 run -- for a process that is running.
875 stop -- for a process stopped but continuable.
876 exit -- for a process that has exited.
877 signal -- for a process that has got a fatal signal.
878 open -- for a network stream connection that is open.
879 listen -- for a network stream server that is listening.
880 closed -- for a network stream connection that is closed.
881 connect -- when waiting for a non-blocking connection to complete.
882 failed -- when a non-blocking connection has failed.
883 nil -- if arg is a process name and no such process exists.
884 PROCESS may be a process, a buffer, the name of a process, or
885 nil, indicating the current buffer's process. */)
886 (register Lisp_Object process)
888 register struct Lisp_Process *p;
889 register Lisp_Object status;
891 if (STRINGP (process))
892 process = Fget_process (process);
893 else
894 process = get_process (process);
896 if (NILP (process))
897 return process;
899 p = XPROCESS (process);
900 if (p->raw_status_new)
901 update_status (p);
902 status = p->status;
903 if (CONSP (status))
904 status = XCAR (status);
905 if (NETCONN1_P (p) || SERIALCONN1_P (p))
907 if (EQ (status, Qexit))
908 status = Qclosed;
909 else if (EQ (p->command, Qt))
910 status = Qstop;
911 else if (EQ (status, Qrun))
912 status = Qopen;
914 return status;
917 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
918 1, 1, 0,
919 doc: /* Return the exit status of PROCESS or the signal number that killed it.
920 If PROCESS has not yet exited or died, return 0. */)
921 (register Lisp_Object process)
923 CHECK_PROCESS (process);
924 if (XPROCESS (process)->raw_status_new)
925 update_status (XPROCESS (process));
926 if (CONSP (XPROCESS (process)->status))
927 return XCAR (XCDR (XPROCESS (process)->status));
928 return make_number (0);
931 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
932 doc: /* Return the process id of PROCESS.
933 This is the pid of the external process which PROCESS uses or talks to.
934 For a network connection, this value is nil. */)
935 (register Lisp_Object process)
937 pid_t pid;
939 CHECK_PROCESS (process);
940 pid = XPROCESS (process)->pid;
941 return (pid ? make_fixnum_or_float (pid) : Qnil);
944 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
945 doc: /* Return the name of PROCESS, as a string.
946 This is the name of the program invoked in PROCESS,
947 possibly modified to make it unique among process names. */)
948 (register Lisp_Object process)
950 CHECK_PROCESS (process);
951 return XPROCESS (process)->name;
954 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
955 doc: /* Return the command that was executed to start PROCESS.
956 This is a list of strings, the first string being the program executed
957 and the rest of the strings being the arguments given to it.
958 For a network or serial process, this is nil (process is running) or t
959 \(process is stopped). */)
960 (register Lisp_Object process)
962 CHECK_PROCESS (process);
963 return XPROCESS (process)->command;
966 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
967 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
968 This is the terminal that the process itself reads and writes on,
969 not the name of the pty that Emacs uses to talk with that terminal. */)
970 (register Lisp_Object process)
972 CHECK_PROCESS (process);
973 return XPROCESS (process)->tty_name;
976 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
977 2, 2, 0,
978 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
979 Return BUFFER. */)
980 (register Lisp_Object process, Lisp_Object buffer)
982 struct Lisp_Process *p;
984 CHECK_PROCESS (process);
985 if (!NILP (buffer))
986 CHECK_BUFFER (buffer);
987 p = XPROCESS (process);
988 pset_buffer (p, buffer);
989 if (NETCONN1_P (p) || SERIALCONN1_P (p))
990 pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
991 setup_process_coding_systems (process);
992 return buffer;
995 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
996 1, 1, 0,
997 doc: /* Return the buffer PROCESS is associated with.
998 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
999 (register Lisp_Object process)
1001 CHECK_PROCESS (process);
1002 return XPROCESS (process)->buffer;
1005 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1006 1, 1, 0,
1007 doc: /* Return the marker for the end of the last output from PROCESS. */)
1008 (register Lisp_Object process)
1010 CHECK_PROCESS (process);
1011 return XPROCESS (process)->mark;
1014 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1015 2, 2, 0,
1016 doc: /* Give PROCESS the filter function FILTER; nil means default.
1017 A value of t means stop accepting output from the process.
1019 When a process has a non-default filter, its buffer is not used for output.
1020 Instead, each time it does output, the entire string of output is
1021 passed to the filter.
1023 The filter gets two arguments: the process and the string of output.
1024 The string argument is normally a multibyte string, except:
1025 - if the process' input coding system is no-conversion or raw-text,
1026 it is a unibyte string (the non-converted input), or else
1027 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1028 string (the result of converting the decoded input multibyte
1029 string to unibyte with `string-make-unibyte'). */)
1030 (register Lisp_Object process, Lisp_Object filter)
1032 struct Lisp_Process *p;
1034 CHECK_PROCESS (process);
1035 p = XPROCESS (process);
1037 /* Don't signal an error if the process' input file descriptor
1038 is closed. This could make debugging Lisp more difficult,
1039 for example when doing something like
1041 (setq process (start-process ...))
1042 (debug)
1043 (set-process-filter process ...) */
1045 if (NILP (filter))
1046 filter = Qinternal_default_process_filter;
1048 if (p->infd >= 0)
1050 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
1052 FD_CLR (p->infd, &input_wait_mask);
1053 FD_CLR (p->infd, &non_keyboard_wait_mask);
1055 else if (EQ (p->filter, Qt)
1056 /* Network or serial process not stopped: */
1057 && !EQ (p->command, Qt))
1059 FD_SET (p->infd, &input_wait_mask);
1060 FD_SET (p->infd, &non_keyboard_wait_mask);
1064 pset_filter (p, filter);
1065 if (NETCONN1_P (p) || SERIALCONN1_P (p))
1066 pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
1067 setup_process_coding_systems (process);
1068 return filter;
1071 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1072 1, 1, 0,
1073 doc: /* Return the filter function of PROCESS.
1074 See `set-process-filter' for more info on filter functions. */)
1075 (register Lisp_Object process)
1077 CHECK_PROCESS (process);
1078 return XPROCESS (process)->filter;
1081 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1082 2, 2, 0,
1083 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1084 The sentinel is called as a function when the process changes state.
1085 It gets two arguments: the process, and a string describing the change. */)
1086 (register Lisp_Object process, Lisp_Object sentinel)
1088 struct Lisp_Process *p;
1090 CHECK_PROCESS (process);
1091 p = XPROCESS (process);
1093 if (NILP (sentinel))
1094 sentinel = Qinternal_default_process_sentinel;
1096 pset_sentinel (p, sentinel);
1097 if (NETCONN1_P (p) || SERIALCONN1_P (p))
1098 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
1099 return sentinel;
1102 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1103 1, 1, 0,
1104 doc: /* Return the sentinel of PROCESS.
1105 See `set-process-sentinel' for more info on sentinels. */)
1106 (register Lisp_Object process)
1108 CHECK_PROCESS (process);
1109 return XPROCESS (process)->sentinel;
1112 DEFUN ("set-process-window-size", Fset_process_window_size,
1113 Sset_process_window_size, 3, 3, 0,
1114 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1115 (register Lisp_Object process, Lisp_Object height, Lisp_Object width)
1117 CHECK_PROCESS (process);
1118 CHECK_RANGED_INTEGER (height, 0, INT_MAX);
1119 CHECK_RANGED_INTEGER (width, 0, INT_MAX);
1121 if (XPROCESS (process)->infd < 0
1122 || set_window_size (XPROCESS (process)->infd,
1123 XINT (height), XINT (width)) <= 0)
1124 return Qnil;
1125 else
1126 return Qt;
1129 DEFUN ("set-process-inherit-coding-system-flag",
1130 Fset_process_inherit_coding_system_flag,
1131 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1132 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1133 If the second argument FLAG is non-nil, then the variable
1134 `buffer-file-coding-system' of the buffer associated with PROCESS
1135 will be bound to the value of the coding system used to decode
1136 the process output.
1138 This is useful when the coding system specified for the process buffer
1139 leaves either the character code conversion or the end-of-line conversion
1140 unspecified, or if the coding system used to decode the process output
1141 is more appropriate for saving the process buffer.
1143 Binding the variable `inherit-process-coding-system' to non-nil before
1144 starting the process is an alternative way of setting the inherit flag
1145 for the process which will run.
1147 This function returns FLAG. */)
1148 (register Lisp_Object process, Lisp_Object flag)
1150 CHECK_PROCESS (process);
1151 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1152 return flag;
1155 DEFUN ("set-process-query-on-exit-flag",
1156 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1157 2, 2, 0,
1158 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1159 If the second argument FLAG is non-nil, Emacs will query the user before
1160 exiting or killing a buffer if PROCESS is running. This function
1161 returns FLAG. */)
1162 (register Lisp_Object process, Lisp_Object flag)
1164 CHECK_PROCESS (process);
1165 XPROCESS (process)->kill_without_query = NILP (flag);
1166 return flag;
1169 DEFUN ("process-query-on-exit-flag",
1170 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1171 1, 1, 0,
1172 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1173 (register Lisp_Object process)
1175 CHECK_PROCESS (process);
1176 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1179 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1180 1, 2, 0,
1181 doc: /* Return the contact info of PROCESS; t for a real child.
1182 For a network or serial connection, the value depends on the optional
1183 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1184 SERVICE) for a network connection or (PORT SPEED) for a serial
1185 connection. If KEY is t, the complete contact information for the
1186 connection is returned, else the specific value for the keyword KEY is
1187 returned. See `make-network-process' or `make-serial-process' for a
1188 list of keywords. */)
1189 (register Lisp_Object process, Lisp_Object key)
1191 Lisp_Object contact;
1193 CHECK_PROCESS (process);
1194 contact = XPROCESS (process)->childp;
1196 #ifdef DATAGRAM_SOCKETS
1197 if (DATAGRAM_CONN_P (process)
1198 && (EQ (key, Qt) || EQ (key, QCremote)))
1199 contact = Fplist_put (contact, QCremote,
1200 Fprocess_datagram_address (process));
1201 #endif
1203 if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
1204 return contact;
1205 if (NILP (key) && NETCONN_P (process))
1206 return list2 (Fplist_get (contact, QChost),
1207 Fplist_get (contact, QCservice));
1208 if (NILP (key) && SERIALCONN_P (process))
1209 return list2 (Fplist_get (contact, QCport),
1210 Fplist_get (contact, QCspeed));
1211 return Fplist_get (contact, key);
1214 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1215 1, 1, 0,
1216 doc: /* Return the plist of PROCESS. */)
1217 (register Lisp_Object process)
1219 CHECK_PROCESS (process);
1220 return XPROCESS (process)->plist;
1223 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1224 2, 2, 0,
1225 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1226 (register Lisp_Object process, Lisp_Object plist)
1228 CHECK_PROCESS (process);
1229 CHECK_LIST (plist);
1231 pset_plist (XPROCESS (process), plist);
1232 return plist;
1235 #if 0 /* Turned off because we don't currently record this info
1236 in the process. Perhaps add it. */
1237 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1238 doc: /* Return the connection type of PROCESS.
1239 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1240 a socket connection. */)
1241 (Lisp_Object process)
1243 return XPROCESS (process)->type;
1245 #endif
1247 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1248 doc: /* Return the connection type of PROCESS.
1249 The value is either the symbol `real', `network', or `serial'.
1250 PROCESS may be a process, a buffer, the name of a process or buffer, or
1251 nil, indicating the current buffer's process. */)
1252 (Lisp_Object process)
1254 Lisp_Object proc;
1255 proc = get_process (process);
1256 return XPROCESS (proc)->type;
1259 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1260 1, 2, 0,
1261 doc: /* Convert network ADDRESS from internal format to a string.
1262 A 4 or 5 element vector represents an IPv4 address (with port number).
1263 An 8 or 9 element vector represents an IPv6 address (with port number).
1264 If optional second argument OMIT-PORT is non-nil, don't include a port
1265 number in the string, even when present in ADDRESS.
1266 Returns nil if format of ADDRESS is invalid. */)
1267 (Lisp_Object address, Lisp_Object omit_port)
1269 if (NILP (address))
1270 return Qnil;
1272 if (STRINGP (address)) /* AF_LOCAL */
1273 return address;
1275 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1277 register struct Lisp_Vector *p = XVECTOR (address);
1278 ptrdiff_t size = p->header.size;
1279 Lisp_Object args[10];
1280 int nargs, i;
1282 if (size == 4 || (size == 5 && !NILP (omit_port)))
1284 args[0] = build_string ("%d.%d.%d.%d");
1285 nargs = 4;
1287 else if (size == 5)
1289 args[0] = build_string ("%d.%d.%d.%d:%d");
1290 nargs = 5;
1292 else if (size == 8 || (size == 9 && !NILP (omit_port)))
1294 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1295 nargs = 8;
1297 else if (size == 9)
1299 args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1300 nargs = 9;
1302 else
1303 return Qnil;
1305 for (i = 0; i < nargs; i++)
1307 if (! RANGED_INTEGERP (0, p->contents[i], 65535))
1308 return Qnil;
1310 if (nargs <= 5 /* IPv4 */
1311 && i < 4 /* host, not port */
1312 && XINT (p->contents[i]) > 255)
1313 return Qnil;
1315 args[i+1] = p->contents[i];
1318 return Fformat (nargs+1, args);
1321 if (CONSP (address))
1323 Lisp_Object args[2];
1324 args[0] = build_string ("<Family %d>");
1325 args[1] = Fcar (address);
1326 return Fformat (2, args);
1329 return Qnil;
1332 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1333 doc: /* Return a list of all processes. */)
1334 (void)
1336 return Fmapcar (Qcdr, Vprocess_alist);
1339 /* Starting asynchronous inferior processes. */
1341 static void start_process_unwind (Lisp_Object proc);
1343 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1344 doc: /* Start a program in a subprocess. Return the process object for it.
1345 NAME is name for process. It is modified if necessary to make it unique.
1346 BUFFER is the buffer (or buffer name) to associate with the process.
1348 Process output (both standard output and standard error streams) goes
1349 at end of BUFFER, unless you specify an output stream or filter
1350 function to handle the output. BUFFER may also be nil, meaning that
1351 this process is not associated with any buffer.
1353 PROGRAM is the program file name. It is searched for in `exec-path'
1354 (which see). If nil, just associate a pty with the buffer. Remaining
1355 arguments are strings to give program as arguments.
1357 If you want to separate standard output from standard error, invoke
1358 the command through a shell and redirect one of them using the shell
1359 syntax.
1361 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1362 (ptrdiff_t nargs, Lisp_Object *args)
1364 Lisp_Object buffer, name, program, proc, current_dir, tem;
1365 register unsigned char **new_argv;
1366 ptrdiff_t i;
1367 ptrdiff_t count = SPECPDL_INDEX ();
1369 buffer = args[1];
1370 if (!NILP (buffer))
1371 buffer = Fget_buffer_create (buffer);
1373 /* Make sure that the child will be able to chdir to the current
1374 buffer's current directory, or its unhandled equivalent. We
1375 can't just have the child check for an error when it does the
1376 chdir, since it's in a vfork.
1378 We have to GCPRO around this because Fexpand_file_name and
1379 Funhandled_file_name_directory might call a file name handling
1380 function. The argument list is protected by the caller, so all
1381 we really have to worry about is buffer. */
1383 struct gcpro gcpro1, gcpro2;
1385 current_dir = BVAR (current_buffer, directory);
1387 GCPRO2 (buffer, current_dir);
1389 current_dir = Funhandled_file_name_directory (current_dir);
1390 if (NILP (current_dir))
1391 /* If the file name handler says that current_dir is unreachable, use
1392 a sensible default. */
1393 current_dir = build_string ("~/");
1394 current_dir = expand_and_dir_to_file (current_dir, Qnil);
1395 if (NILP (Ffile_accessible_directory_p (current_dir)))
1396 report_file_error ("Setting current directory",
1397 BVAR (current_buffer, directory));
1399 UNGCPRO;
1402 name = args[0];
1403 CHECK_STRING (name);
1405 program = args[2];
1407 if (!NILP (program))
1408 CHECK_STRING (program);
1410 proc = make_process (name);
1411 /* If an error occurs and we can't start the process, we want to
1412 remove it from the process list. This means that each error
1413 check in create_process doesn't need to call remove_process
1414 itself; it's all taken care of here. */
1415 record_unwind_protect (start_process_unwind, proc);
1417 pset_childp (XPROCESS (proc), Qt);
1418 pset_plist (XPROCESS (proc), Qnil);
1419 pset_type (XPROCESS (proc), Qreal);
1420 pset_buffer (XPROCESS (proc), buffer);
1421 pset_sentinel (XPROCESS (proc), Qinternal_default_process_sentinel);
1422 pset_filter (XPROCESS (proc), Qinternal_default_process_filter);
1423 pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
1425 #ifdef HAVE_GNUTLS
1426 /* AKA GNUTLS_INITSTAGE(proc). */
1427 XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
1428 pset_gnutls_cred_type (XPROCESS (proc), Qnil);
1429 #endif
1431 #ifdef ADAPTIVE_READ_BUFFERING
1432 XPROCESS (proc)->adaptive_read_buffering
1433 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1434 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1435 #endif
1437 /* Make the process marker point into the process buffer (if any). */
1438 if (BUFFERP (buffer))
1439 set_marker_both (XPROCESS (proc)->mark, buffer,
1440 BUF_ZV (XBUFFER (buffer)),
1441 BUF_ZV_BYTE (XBUFFER (buffer)));
1444 /* Decide coding systems for communicating with the process. Here
1445 we don't setup the structure coding_system nor pay attention to
1446 unibyte mode. They are done in create_process. */
1448 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1449 Lisp_Object coding_systems = Qt;
1450 Lisp_Object val, *args2;
1451 struct gcpro gcpro1, gcpro2;
1453 val = Vcoding_system_for_read;
1454 if (NILP (val))
1456 args2 = alloca ((nargs + 1) * sizeof *args2);
1457 args2[0] = Qstart_process;
1458 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1459 GCPRO2 (proc, current_dir);
1460 if (!NILP (program))
1461 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1462 UNGCPRO;
1463 if (CONSP (coding_systems))
1464 val = XCAR (coding_systems);
1465 else if (CONSP (Vdefault_process_coding_system))
1466 val = XCAR (Vdefault_process_coding_system);
1468 pset_decode_coding_system (XPROCESS (proc), val);
1470 val = Vcoding_system_for_write;
1471 if (NILP (val))
1473 if (EQ (coding_systems, Qt))
1475 args2 = alloca ((nargs + 1) * sizeof *args2);
1476 args2[0] = Qstart_process;
1477 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1478 GCPRO2 (proc, current_dir);
1479 if (!NILP (program))
1480 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1481 UNGCPRO;
1483 if (CONSP (coding_systems))
1484 val = XCDR (coding_systems);
1485 else if (CONSP (Vdefault_process_coding_system))
1486 val = XCDR (Vdefault_process_coding_system);
1488 pset_encode_coding_system (XPROCESS (proc), val);
1489 /* Note: At this moment, the above coding system may leave
1490 text-conversion or eol-conversion unspecified. They will be
1491 decided after we read output from the process and decode it by
1492 some coding system, or just before we actually send a text to
1493 the process. */
1497 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1498 XPROCESS (proc)->decoding_carryover = 0;
1499 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1501 XPROCESS (proc)->inherit_coding_system_flag
1502 = !(NILP (buffer) || !inherit_process_coding_system);
1504 if (!NILP (program))
1506 /* If program file name is not absolute, search our path for it.
1507 Put the name we will really use in TEM. */
1508 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1509 && !(SCHARS (program) > 1
1510 && IS_DEVICE_SEP (SREF (program, 1))))
1512 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1514 tem = Qnil;
1515 GCPRO4 (name, program, buffer, current_dir);
1516 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
1517 UNGCPRO;
1518 if (NILP (tem))
1519 report_file_error ("Searching for program", program);
1520 tem = Fexpand_file_name (tem, Qnil);
1522 else
1524 if (!NILP (Ffile_directory_p (program)))
1525 error ("Specified program for new process is a directory");
1526 tem = program;
1529 /* If program file name starts with /: for quoting a magic name,
1530 discard that. */
1531 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
1532 && SREF (tem, 1) == ':')
1533 tem = Fsubstring (tem, make_number (2), Qnil);
1536 Lisp_Object arg_encoding = Qnil;
1537 struct gcpro gcpro1;
1538 GCPRO1 (tem);
1540 /* Encode the file name and put it in NEW_ARGV.
1541 That's where the child will use it to execute the program. */
1542 tem = list1 (ENCODE_FILE (tem));
1544 /* Here we encode arguments by the coding system used for sending
1545 data to the process. We don't support using different coding
1546 systems for encoding arguments and for encoding data sent to the
1547 process. */
1549 for (i = 3; i < nargs; i++)
1551 tem = Fcons (args[i], tem);
1552 CHECK_STRING (XCAR (tem));
1553 if (STRING_MULTIBYTE (XCAR (tem)))
1555 if (NILP (arg_encoding))
1556 arg_encoding = (complement_process_encoding_system
1557 (XPROCESS (proc)->encode_coding_system));
1558 XSETCAR (tem,
1559 code_convert_string_norecord
1560 (XCAR (tem), arg_encoding, 1));
1564 UNGCPRO;
1567 /* Now that everything is encoded we can collect the strings into
1568 NEW_ARGV. */
1569 new_argv = alloca ((nargs - 1) * sizeof *new_argv);
1570 new_argv[nargs - 2] = 0;
1572 for (i = nargs - 2; i-- != 0; )
1574 new_argv[i] = SDATA (XCAR (tem));
1575 tem = XCDR (tem);
1578 create_process (proc, (char **) new_argv, current_dir);
1580 else
1581 create_pty (proc);
1583 return unbind_to (count, proc);
1586 /* This function is the unwind_protect form for Fstart_process. If
1587 PROC doesn't have its pid set, then we know someone has signaled
1588 an error and the process wasn't started successfully, so we should
1589 remove it from the process list. */
1590 static void
1591 start_process_unwind (Lisp_Object proc)
1593 if (!PROCESSP (proc))
1594 emacs_abort ();
1596 /* Was PROC started successfully?
1597 -2 is used for a pty with no process, eg for gdb. */
1598 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1599 remove_process (proc);
1603 static void
1604 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1606 int inchannel, outchannel;
1607 pid_t pid;
1608 int vfork_errno;
1609 int sv[2];
1610 #ifndef WINDOWSNT
1611 int wait_child_setup[2];
1612 #endif
1613 int forkin, forkout;
1614 bool pty_flag = 0;
1615 char pty_name[PTY_NAME_SIZE];
1616 Lisp_Object lisp_pty_name = Qnil;
1617 Lisp_Object encoded_current_dir;
1619 inchannel = outchannel = -1;
1621 if (!NILP (Vprocess_connection_type))
1622 outchannel = inchannel = allocate_pty (pty_name);
1624 if (inchannel >= 0)
1626 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1627 /* On most USG systems it does not work to open the pty's tty here,
1628 then close it and reopen it in the child. */
1629 /* Don't let this terminal become our controlling terminal
1630 (in case we don't have one). */
1631 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1632 if (forkin < 0)
1633 report_file_error ("Opening pty", Qnil);
1634 #else
1635 forkin = forkout = -1;
1636 #endif /* not USG, or USG_SUBTTY_WORKS */
1637 pty_flag = 1;
1638 lisp_pty_name = build_string (pty_name);
1640 else
1642 if (emacs_pipe (sv) != 0)
1643 report_file_error ("Creating pipe", Qnil);
1644 inchannel = sv[0];
1645 forkout = sv[1];
1646 if (emacs_pipe (sv) != 0)
1648 int pipe_errno = errno;
1649 emacs_close (inchannel);
1650 emacs_close (forkout);
1651 report_file_errno ("Creating pipe", Qnil, pipe_errno);
1653 outchannel = sv[1];
1654 forkin = sv[0];
1657 #ifndef WINDOWSNT
1658 if (emacs_pipe (wait_child_setup) != 0)
1659 report_file_error ("Creating pipe", Qnil);
1660 #endif
1662 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1663 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1665 /* Record this as an active process, with its channels. */
1666 chan_process[inchannel] = process;
1667 XPROCESS (process)->infd = inchannel;
1668 XPROCESS (process)->outfd = outchannel;
1670 /* Previously we recorded the tty descriptor used in the subprocess.
1671 It was only used for getting the foreground tty process, so now
1672 we just reopen the device (see emacs_get_tty_pgrp) as this is
1673 more portable (see USG_SUBTTY_WORKS above). */
1675 XPROCESS (process)->pty_flag = pty_flag;
1676 pset_status (XPROCESS (process), Qrun);
1678 FD_SET (inchannel, &input_wait_mask);
1679 FD_SET (inchannel, &non_keyboard_wait_mask);
1680 if (inchannel > max_process_desc)
1681 max_process_desc = inchannel;
1683 /* This may signal an error. */
1684 setup_process_coding_systems (process);
1686 encoded_current_dir = ENCODE_FILE (current_dir);
1688 block_input ();
1689 block_child_signal ();
1691 #ifndef WINDOWSNT
1692 /* vfork, and prevent local vars from being clobbered by the vfork. */
1694 Lisp_Object volatile encoded_current_dir_volatile = encoded_current_dir;
1695 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
1696 Lisp_Object volatile process_volatile = process;
1697 char **volatile new_argv_volatile = new_argv;
1698 int volatile forkin_volatile = forkin;
1699 int volatile forkout_volatile = forkout;
1700 int volatile wait_child_setup_0_volatile = wait_child_setup[0];
1701 int volatile wait_child_setup_1_volatile = wait_child_setup[1];
1703 pid = vfork ();
1705 encoded_current_dir = encoded_current_dir_volatile;
1706 lisp_pty_name = lisp_pty_name_volatile;
1707 process = process_volatile;
1708 new_argv = new_argv_volatile;
1709 forkin = forkin_volatile;
1710 forkout = forkout_volatile;
1711 wait_child_setup[0] = wait_child_setup_0_volatile;
1712 wait_child_setup[1] = wait_child_setup_1_volatile;
1714 pty_flag = XPROCESS (process)->pty_flag;
1717 if (pid == 0)
1718 #endif /* not WINDOWSNT */
1720 int xforkin = forkin;
1721 int xforkout = forkout;
1723 /* Make the pty be the controlling terminal of the process. */
1724 #ifdef HAVE_PTYS
1725 /* First, disconnect its current controlling terminal. */
1726 /* We tried doing setsid only if pty_flag, but it caused
1727 process_set_signal to fail on SGI when using a pipe. */
1728 setsid ();
1729 /* Make the pty's terminal the controlling terminal. */
1730 if (pty_flag && xforkin >= 0)
1732 #ifdef TIOCSCTTY
1733 /* We ignore the return value
1734 because faith@cs.unc.edu says that is necessary on Linux. */
1735 ioctl (xforkin, TIOCSCTTY, 0);
1736 #endif
1738 #if defined (LDISC1)
1739 if (pty_flag && xforkin >= 0)
1741 struct termios t;
1742 tcgetattr (xforkin, &t);
1743 t.c_lflag = LDISC1;
1744 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
1745 emacs_perror ("create_process/tcsetattr LDISC1");
1747 #else
1748 #if defined (NTTYDISC) && defined (TIOCSETD)
1749 if (pty_flag && xforkin >= 0)
1751 /* Use new line discipline. */
1752 int ldisc = NTTYDISC;
1753 ioctl (xforkin, TIOCSETD, &ldisc);
1755 #endif
1756 #endif
1757 #ifdef TIOCNOTTY
1758 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1759 can do TIOCSPGRP only to the process's controlling tty. */
1760 if (pty_flag)
1762 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1763 I can't test it since I don't have 4.3. */
1764 int j = emacs_open ("/dev/tty", O_RDWR, 0);
1765 if (j >= 0)
1767 ioctl (j, TIOCNOTTY, 0);
1768 emacs_close (j);
1771 #endif /* TIOCNOTTY */
1773 #if !defined (DONT_REOPEN_PTY)
1774 /*** There is a suggestion that this ought to be a
1775 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
1776 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1777 that system does seem to need this code, even though
1778 both TIOCSCTTY is defined. */
1779 /* Now close the pty (if we had it open) and reopen it.
1780 This makes the pty the controlling terminal of the subprocess. */
1781 if (pty_flag)
1784 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
1785 would work? */
1786 if (xforkin >= 0)
1787 emacs_close (xforkin);
1788 xforkout = xforkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
1790 if (xforkin < 0)
1792 emacs_perror (SSDATA (lisp_pty_name));
1793 _exit (EXIT_CANCELED);
1797 #endif /* not DONT_REOPEN_PTY */
1799 #ifdef SETUP_SLAVE_PTY
1800 if (pty_flag)
1802 SETUP_SLAVE_PTY;
1804 #endif /* SETUP_SLAVE_PTY */
1805 #endif /* HAVE_PTYS */
1807 signal (SIGINT, SIG_DFL);
1808 signal (SIGQUIT, SIG_DFL);
1810 /* Emacs ignores SIGPIPE, but the child should not. */
1811 signal (SIGPIPE, SIG_DFL);
1813 /* Stop blocking SIGCHLD in the child. */
1814 unblock_child_signal ();
1816 if (pty_flag)
1817 child_setup_tty (xforkout);
1818 #ifdef WINDOWSNT
1819 pid = child_setup (xforkin, xforkout, xforkout,
1820 new_argv, 1, encoded_current_dir);
1821 #else /* not WINDOWSNT */
1822 child_setup (xforkin, xforkout, xforkout,
1823 new_argv, 1, encoded_current_dir);
1824 #endif /* not WINDOWSNT */
1827 /* Back in the parent process. */
1829 vfork_errno = errno;
1830 XPROCESS (process)->pid = pid;
1831 if (pid >= 0)
1832 XPROCESS (process)->alive = 1;
1834 /* Stop blocking in the parent. */
1835 unblock_child_signal ();
1836 unblock_input ();
1838 if (forkin >= 0)
1839 emacs_close (forkin);
1840 if (forkin != forkout && forkout >= 0)
1841 emacs_close (forkout);
1843 if (pid < 0)
1844 report_file_errno ("Doing vfork", Qnil, vfork_errno);
1845 else
1847 /* vfork succeeded. */
1849 #ifdef WINDOWSNT
1850 register_child (pid, inchannel);
1851 #endif /* WINDOWSNT */
1853 pset_tty_name (XPROCESS (process), lisp_pty_name);
1855 #ifndef WINDOWSNT
1856 /* Wait for child_setup to complete in case that vfork is
1857 actually defined as fork. The descriptor wait_child_setup[1]
1858 of a pipe is closed at the child side either by close-on-exec
1859 on successful execve or the _exit call in child_setup. */
1861 char dummy;
1863 emacs_close (wait_child_setup[1]);
1864 emacs_read (wait_child_setup[0], &dummy, 1);
1865 emacs_close (wait_child_setup[0]);
1867 #endif
1871 static void
1872 create_pty (Lisp_Object process)
1874 char pty_name[PTY_NAME_SIZE];
1875 int inchannel, outchannel;
1877 inchannel = outchannel = -1;
1879 if (!NILP (Vprocess_connection_type))
1880 outchannel = inchannel = allocate_pty (pty_name);
1882 if (inchannel >= 0)
1884 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1885 /* On most USG systems it does not work to open the pty's tty here,
1886 then close it and reopen it in the child. */
1887 /* Don't let this terminal become our controlling terminal
1888 (in case we don't have one). */
1889 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1890 if (forkout < 0)
1891 report_file_error ("Opening pty", Qnil);
1892 #if defined (DONT_REOPEN_PTY)
1893 /* In the case that vfork is defined as fork, the parent process
1894 (Emacs) may send some data before the child process completes
1895 tty options setup. So we setup tty before forking. */
1896 child_setup_tty (forkout);
1897 #endif /* DONT_REOPEN_PTY */
1898 #endif /* not USG, or USG_SUBTTY_WORKS */
1900 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1901 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1903 /* Record this as an active process, with its channels.
1904 As a result, child_setup will close Emacs's side of the pipes. */
1905 chan_process[inchannel] = process;
1906 XPROCESS (process)->infd = inchannel;
1907 XPROCESS (process)->outfd = outchannel;
1909 /* Previously we recorded the tty descriptor used in the subprocess.
1910 It was only used for getting the foreground tty process, so now
1911 we just reopen the device (see emacs_get_tty_pgrp) as this is
1912 more portable (see USG_SUBTTY_WORKS above). */
1914 XPROCESS (process)->pty_flag = 1;
1915 pset_status (XPROCESS (process), Qrun);
1916 setup_process_coding_systems (process);
1918 FD_SET (inchannel, &input_wait_mask);
1919 FD_SET (inchannel, &non_keyboard_wait_mask);
1920 if (inchannel > max_process_desc)
1921 max_process_desc = inchannel;
1923 pset_tty_name (XPROCESS (process), build_string (pty_name));
1926 XPROCESS (process)->pid = -2;
1930 /* Convert an internal struct sockaddr to a lisp object (vector or string).
1931 The address family of sa is not included in the result. */
1933 static Lisp_Object
1934 conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
1936 Lisp_Object address;
1937 int i;
1938 unsigned char *cp;
1939 register struct Lisp_Vector *p;
1941 /* Workaround for a bug in getsockname on BSD: Names bound to
1942 sockets in the UNIX domain are inaccessible; getsockname returns
1943 a zero length name. */
1944 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
1945 return empty_unibyte_string;
1947 switch (sa->sa_family)
1949 case AF_INET:
1951 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
1952 len = sizeof (sin->sin_addr) + 1;
1953 address = Fmake_vector (make_number (len), Qnil);
1954 p = XVECTOR (address);
1955 p->contents[--len] = make_number (ntohs (sin->sin_port));
1956 cp = (unsigned char *) &sin->sin_addr;
1957 break;
1959 #ifdef AF_INET6
1960 case AF_INET6:
1962 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
1963 uint16_t *ip6 = (uint16_t *) &sin6->sin6_addr;
1964 len = sizeof (sin6->sin6_addr)/2 + 1;
1965 address = Fmake_vector (make_number (len), Qnil);
1966 p = XVECTOR (address);
1967 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
1968 for (i = 0; i < len; i++)
1969 p->contents[i] = make_number (ntohs (ip6[i]));
1970 return address;
1972 #endif
1973 #ifdef HAVE_LOCAL_SOCKETS
1974 case AF_LOCAL:
1976 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
1977 for (i = 0; i < sizeof (sockun->sun_path); i++)
1978 if (sockun->sun_path[i] == 0)
1979 break;
1980 return make_unibyte_string (sockun->sun_path, i);
1982 #endif
1983 default:
1984 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
1985 address = Fcons (make_number (sa->sa_family),
1986 Fmake_vector (make_number (len), Qnil));
1987 p = XVECTOR (XCDR (address));
1988 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
1989 break;
1992 i = 0;
1993 while (i < len)
1994 p->contents[i++] = make_number (*cp++);
1996 return address;
2000 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2002 static int
2003 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2005 register struct Lisp_Vector *p;
2007 if (VECTORP (address))
2009 p = XVECTOR (address);
2010 if (p->header.size == 5)
2012 *familyp = AF_INET;
2013 return sizeof (struct sockaddr_in);
2015 #ifdef AF_INET6
2016 else if (p->header.size == 9)
2018 *familyp = AF_INET6;
2019 return sizeof (struct sockaddr_in6);
2021 #endif
2023 #ifdef HAVE_LOCAL_SOCKETS
2024 else if (STRINGP (address))
2026 *familyp = AF_LOCAL;
2027 return sizeof (struct sockaddr_un);
2029 #endif
2030 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2031 && VECTORP (XCDR (address)))
2033 struct sockaddr *sa;
2034 *familyp = XINT (XCAR (address));
2035 p = XVECTOR (XCDR (address));
2036 return p->header.size + sizeof (sa->sa_family);
2038 return 0;
2041 /* Convert an address object (vector or string) to an internal sockaddr.
2043 The address format has been basically validated by
2044 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2045 it could have come from user data. So if FAMILY is not valid,
2046 we return after zeroing *SA. */
2048 static void
2049 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2051 register struct Lisp_Vector *p;
2052 register unsigned char *cp = NULL;
2053 register int i;
2054 EMACS_INT hostport;
2056 memset (sa, 0, len);
2058 if (VECTORP (address))
2060 p = XVECTOR (address);
2061 if (family == AF_INET)
2063 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2064 len = sizeof (sin->sin_addr) + 1;
2065 hostport = XINT (p->contents[--len]);
2066 sin->sin_port = htons (hostport);
2067 cp = (unsigned char *)&sin->sin_addr;
2068 sa->sa_family = family;
2070 #ifdef AF_INET6
2071 else if (family == AF_INET6)
2073 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2074 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2075 len = sizeof (sin6->sin6_addr) + 1;
2076 hostport = XINT (p->contents[--len]);
2077 sin6->sin6_port = htons (hostport);
2078 for (i = 0; i < len; i++)
2079 if (INTEGERP (p->contents[i]))
2081 int j = XFASTINT (p->contents[i]) & 0xffff;
2082 ip6[i] = ntohs (j);
2084 sa->sa_family = family;
2085 return;
2087 #endif
2088 else
2089 return;
2091 else if (STRINGP (address))
2093 #ifdef HAVE_LOCAL_SOCKETS
2094 if (family == AF_LOCAL)
2096 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2097 cp = SDATA (address);
2098 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2099 sockun->sun_path[i] = *cp++;
2100 sa->sa_family = family;
2102 #endif
2103 return;
2105 else
2107 p = XVECTOR (XCDR (address));
2108 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2111 for (i = 0; i < len; i++)
2112 if (INTEGERP (p->contents[i]))
2113 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2116 #ifdef DATAGRAM_SOCKETS
2117 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2118 1, 1, 0,
2119 doc: /* Get the current datagram address associated with PROCESS. */)
2120 (Lisp_Object process)
2122 int channel;
2124 CHECK_PROCESS (process);
2126 if (!DATAGRAM_CONN_P (process))
2127 return Qnil;
2129 channel = XPROCESS (process)->infd;
2130 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2131 datagram_address[channel].len);
2134 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2135 2, 2, 0,
2136 doc: /* Set the datagram address for PROCESS to ADDRESS.
2137 Returns nil upon error setting address, ADDRESS otherwise. */)
2138 (Lisp_Object process, Lisp_Object address)
2140 int channel;
2141 int family, len;
2143 CHECK_PROCESS (process);
2145 if (!DATAGRAM_CONN_P (process))
2146 return Qnil;
2148 channel = XPROCESS (process)->infd;
2150 len = get_lisp_to_sockaddr_size (address, &family);
2151 if (len == 0 || datagram_address[channel].len != len)
2152 return Qnil;
2153 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2154 return address;
2156 #endif
2159 static const struct socket_options {
2160 /* The name of this option. Should be lowercase version of option
2161 name without SO_ prefix. */
2162 const char *name;
2163 /* Option level SOL_... */
2164 int optlevel;
2165 /* Option number SO_... */
2166 int optnum;
2167 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2168 enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
2169 } socket_options[] =
2171 #ifdef SO_BINDTODEVICE
2172 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2173 #endif
2174 #ifdef SO_BROADCAST
2175 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2176 #endif
2177 #ifdef SO_DONTROUTE
2178 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2179 #endif
2180 #ifdef SO_KEEPALIVE
2181 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2182 #endif
2183 #ifdef SO_LINGER
2184 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2185 #endif
2186 #ifdef SO_OOBINLINE
2187 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2188 #endif
2189 #ifdef SO_PRIORITY
2190 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2191 #endif
2192 #ifdef SO_REUSEADDR
2193 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2194 #endif
2195 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2198 /* Set option OPT to value VAL on socket S.
2200 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2201 Signals an error if setting a known option fails.
2204 static int
2205 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2207 char *name;
2208 const struct socket_options *sopt;
2209 int ret = 0;
2211 CHECK_SYMBOL (opt);
2213 name = SSDATA (SYMBOL_NAME (opt));
2214 for (sopt = socket_options; sopt->name; sopt++)
2215 if (strcmp (name, sopt->name) == 0)
2216 break;
2218 switch (sopt->opttype)
2220 case SOPT_BOOL:
2222 int optval;
2223 optval = NILP (val) ? 0 : 1;
2224 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2225 &optval, sizeof (optval));
2226 break;
2229 case SOPT_INT:
2231 int optval;
2232 if (TYPE_RANGED_INTEGERP (int, val))
2233 optval = XINT (val);
2234 else
2235 error ("Bad option value for %s", name);
2236 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2237 &optval, sizeof (optval));
2238 break;
2241 #ifdef SO_BINDTODEVICE
2242 case SOPT_IFNAME:
2244 char devname[IFNAMSIZ+1];
2246 /* This is broken, at least in the Linux 2.4 kernel.
2247 To unbind, the arg must be a zero integer, not the empty string.
2248 This should work on all systems. KFS. 2003-09-23. */
2249 memset (devname, 0, sizeof devname);
2250 if (STRINGP (val))
2252 char *arg = SSDATA (val);
2253 int len = min (strlen (arg), IFNAMSIZ);
2254 memcpy (devname, arg, len);
2256 else if (!NILP (val))
2257 error ("Bad option value for %s", name);
2258 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2259 devname, IFNAMSIZ);
2260 break;
2262 #endif
2264 #ifdef SO_LINGER
2265 case SOPT_LINGER:
2267 struct linger linger;
2269 linger.l_onoff = 1;
2270 linger.l_linger = 0;
2271 if (TYPE_RANGED_INTEGERP (int, val))
2272 linger.l_linger = XINT (val);
2273 else
2274 linger.l_onoff = NILP (val) ? 0 : 1;
2275 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2276 &linger, sizeof (linger));
2277 break;
2279 #endif
2281 default:
2282 return 0;
2285 if (ret < 0)
2287 int setsockopt_errno = errno;
2288 report_file_errno ("Cannot set network option", list2 (opt, val),
2289 setsockopt_errno);
2292 return (1 << sopt->optbit);
2296 DEFUN ("set-network-process-option",
2297 Fset_network_process_option, Sset_network_process_option,
2298 3, 4, 0,
2299 doc: /* For network process PROCESS set option OPTION to value VALUE.
2300 See `make-network-process' for a list of options and values.
2301 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2302 OPTION is not a supported option, return nil instead; otherwise return t. */)
2303 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2305 int s;
2306 struct Lisp_Process *p;
2308 CHECK_PROCESS (process);
2309 p = XPROCESS (process);
2310 if (!NETCONN1_P (p))
2311 error ("Process is not a network process");
2313 s = p->infd;
2314 if (s < 0)
2315 error ("Process is not running");
2317 if (set_socket_option (s, option, value))
2319 pset_childp (p, Fplist_put (p->childp, option, value));
2320 return Qt;
2323 if (NILP (no_error))
2324 error ("Unknown or unsupported option");
2326 return Qnil;
2330 DEFUN ("serial-process-configure",
2331 Fserial_process_configure,
2332 Sserial_process_configure,
2333 0, MANY, 0,
2334 doc: /* Configure speed, bytesize, etc. of a serial process.
2336 Arguments are specified as keyword/argument pairs. Attributes that
2337 are not given are re-initialized from the process's current
2338 configuration (available via the function `process-contact') or set to
2339 reasonable default values. The following arguments are defined:
2341 :process PROCESS
2342 :name NAME
2343 :buffer BUFFER
2344 :port PORT
2345 -- Any of these arguments can be given to identify the process that is
2346 to be configured. If none of these arguments is given, the current
2347 buffer's process is used.
2349 :speed SPEED -- SPEED is the speed of the serial port in bits per
2350 second, also called baud rate. Any value can be given for SPEED, but
2351 most serial ports work only at a few defined values between 1200 and
2352 115200, with 9600 being the most common value. If SPEED is nil, the
2353 serial port is not configured any further, i.e., all other arguments
2354 are ignored. This may be useful for special serial ports such as
2355 Bluetooth-to-serial converters which can only be configured through AT
2356 commands. A value of nil for SPEED can be used only when passed
2357 through `make-serial-process' or `serial-term'.
2359 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2360 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2362 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2363 `odd' (use odd parity), or the symbol `even' (use even parity). If
2364 PARITY is not given, no parity is used.
2366 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2367 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2368 is not given or nil, 1 stopbit is used.
2370 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2371 flowcontrol to be used, which is either nil (don't use flowcontrol),
2372 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2373 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2374 flowcontrol is used.
2376 `serial-process-configure' is called by `make-serial-process' for the
2377 initial configuration of the serial port.
2379 Examples:
2381 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2383 \(serial-process-configure
2384 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2386 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2388 usage: (serial-process-configure &rest ARGS) */)
2389 (ptrdiff_t nargs, Lisp_Object *args)
2391 struct Lisp_Process *p;
2392 Lisp_Object contact = Qnil;
2393 Lisp_Object proc = Qnil;
2394 struct gcpro gcpro1;
2396 contact = Flist (nargs, args);
2397 GCPRO1 (contact);
2399 proc = Fplist_get (contact, QCprocess);
2400 if (NILP (proc))
2401 proc = Fplist_get (contact, QCname);
2402 if (NILP (proc))
2403 proc = Fplist_get (contact, QCbuffer);
2404 if (NILP (proc))
2405 proc = Fplist_get (contact, QCport);
2406 proc = get_process (proc);
2407 p = XPROCESS (proc);
2408 if (!EQ (p->type, Qserial))
2409 error ("Not a serial process");
2411 if (NILP (Fplist_get (p->childp, QCspeed)))
2413 UNGCPRO;
2414 return Qnil;
2417 serial_configure (p, contact);
2419 UNGCPRO;
2420 return Qnil;
2423 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2424 0, MANY, 0,
2425 doc: /* Create and return a serial port process.
2427 In Emacs, serial port connections are represented by process objects,
2428 so input and output work as for subprocesses, and `delete-process'
2429 closes a serial port connection. However, a serial process has no
2430 process id, it cannot be signaled, and the status codes are different
2431 from normal processes.
2433 `make-serial-process' creates a process and a buffer, on which you
2434 probably want to use `process-send-string'. Try \\[serial-term] for
2435 an interactive terminal. See below for examples.
2437 Arguments are specified as keyword/argument pairs. The following
2438 arguments are defined:
2440 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2441 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2442 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2443 the backslashes in strings).
2445 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2446 which this function calls.
2448 :name NAME -- NAME is the name of the process. If NAME is not given,
2449 the value of PORT is used.
2451 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2452 with the process. Process output goes at the end of that buffer,
2453 unless you specify an output stream or filter function to handle the
2454 output. If BUFFER is not given, the value of NAME is used.
2456 :coding CODING -- If CODING is a symbol, it specifies the coding
2457 system used for both reading and writing for this process. If CODING
2458 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2459 ENCODING is used for writing.
2461 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2462 the process is running. If BOOL is not given, query before exiting.
2464 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2465 In the stopped state, a serial process does not accept incoming data,
2466 but you can send outgoing data. The stopped state is cleared by
2467 `continue-process' and set by `stop-process'.
2469 :filter FILTER -- Install FILTER as the process filter.
2471 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2473 :plist PLIST -- Install PLIST as the initial plist of the process.
2475 :bytesize
2476 :parity
2477 :stopbits
2478 :flowcontrol
2479 -- This function calls `serial-process-configure' to handle these
2480 arguments.
2482 The original argument list, possibly modified by later configuration,
2483 is available via the function `process-contact'.
2485 Examples:
2487 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2489 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2491 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2493 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2495 usage: (make-serial-process &rest ARGS) */)
2496 (ptrdiff_t nargs, Lisp_Object *args)
2498 int fd = -1;
2499 Lisp_Object proc, contact, port;
2500 struct Lisp_Process *p;
2501 struct gcpro gcpro1;
2502 Lisp_Object name, buffer;
2503 Lisp_Object tem, val;
2504 ptrdiff_t specpdl_count;
2506 if (nargs == 0)
2507 return Qnil;
2509 contact = Flist (nargs, args);
2510 GCPRO1 (contact);
2512 port = Fplist_get (contact, QCport);
2513 if (NILP (port))
2514 error ("No port specified");
2515 CHECK_STRING (port);
2517 if (NILP (Fplist_member (contact, QCspeed)))
2518 error (":speed not specified");
2519 if (!NILP (Fplist_get (contact, QCspeed)))
2520 CHECK_NUMBER (Fplist_get (contact, QCspeed));
2522 name = Fplist_get (contact, QCname);
2523 if (NILP (name))
2524 name = port;
2525 CHECK_STRING (name);
2526 proc = make_process (name);
2527 specpdl_count = SPECPDL_INDEX ();
2528 record_unwind_protect (remove_process, proc);
2529 p = XPROCESS (proc);
2531 fd = serial_open (port);
2532 p->infd = fd;
2533 p->outfd = fd;
2534 if (fd > max_process_desc)
2535 max_process_desc = fd;
2536 chan_process[fd] = proc;
2538 buffer = Fplist_get (contact, QCbuffer);
2539 if (NILP (buffer))
2540 buffer = name;
2541 buffer = Fget_buffer_create (buffer);
2542 pset_buffer (p, buffer);
2544 pset_childp (p, contact);
2545 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2546 pset_type (p, Qserial);
2547 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2548 pset_filter (p, Fplist_get (contact, QCfilter));
2549 pset_log (p, Qnil);
2550 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2551 p->kill_without_query = 1;
2552 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2553 pset_command (p, Qt);
2554 eassert (! p->pty_flag);
2556 if (!EQ (p->command, Qt))
2558 FD_SET (fd, &input_wait_mask);
2559 FD_SET (fd, &non_keyboard_wait_mask);
2562 if (BUFFERP (buffer))
2564 set_marker_both (p->mark, buffer,
2565 BUF_ZV (XBUFFER (buffer)),
2566 BUF_ZV_BYTE (XBUFFER (buffer)));
2569 tem = Fplist_member (contact, QCcoding);
2570 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
2571 tem = Qnil;
2573 val = Qnil;
2574 if (!NILP (tem))
2576 val = XCAR (XCDR (tem));
2577 if (CONSP (val))
2578 val = XCAR (val);
2580 else if (!NILP (Vcoding_system_for_read))
2581 val = Vcoding_system_for_read;
2582 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2583 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2584 val = Qnil;
2585 pset_decode_coding_system (p, val);
2587 val = Qnil;
2588 if (!NILP (tem))
2590 val = XCAR (XCDR (tem));
2591 if (CONSP (val))
2592 val = XCDR (val);
2594 else if (!NILP (Vcoding_system_for_write))
2595 val = Vcoding_system_for_write;
2596 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2597 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2598 val = Qnil;
2599 pset_encode_coding_system (p, val);
2601 setup_process_coding_systems (proc);
2602 pset_decoding_buf (p, empty_unibyte_string);
2603 p->decoding_carryover = 0;
2604 pset_encoding_buf (p, empty_unibyte_string);
2605 p->inherit_coding_system_flag
2606 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
2608 Fserial_process_configure (nargs, args);
2610 specpdl_ptr = specpdl + specpdl_count;
2612 UNGCPRO;
2613 return proc;
2616 /* Create a network stream/datagram client/server process. Treated
2617 exactly like a normal process when reading and writing. Primary
2618 differences are in status display and process deletion. A network
2619 connection has no PID; you cannot signal it. All you can do is
2620 stop/continue it and deactivate/close it via delete-process */
2622 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2623 0, MANY, 0,
2624 doc: /* Create and return a network server or client process.
2626 In Emacs, network connections are represented by process objects, so
2627 input and output work as for subprocesses and `delete-process' closes
2628 a network connection. However, a network process has no process id,
2629 it cannot be signaled, and the status codes are different from normal
2630 processes.
2632 Arguments are specified as keyword/argument pairs. The following
2633 arguments are defined:
2635 :name NAME -- NAME is name for process. It is modified if necessary
2636 to make it unique.
2638 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2639 with the process. Process output goes at end of that buffer, unless
2640 you specify an output stream or filter function to handle the output.
2641 BUFFER may be also nil, meaning that this process is not associated
2642 with any buffer.
2644 :host HOST -- HOST is name of the host to connect to, or its IP
2645 address. The symbol `local' specifies the local host. If specified
2646 for a server process, it must be a valid name or address for the local
2647 host, and only clients connecting to that address will be accepted.
2649 :service SERVICE -- SERVICE is name of the service desired, or an
2650 integer specifying a port number to connect to. If SERVICE is t,
2651 a random port number is selected for the server. (If Emacs was
2652 compiled with getaddrinfo, a port number can also be specified as a
2653 string, e.g. "80", as well as an integer. This is not portable.)
2655 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2656 stream type connection, `datagram' creates a datagram type connection,
2657 `seqpacket' creates a reliable datagram connection.
2659 :family FAMILY -- FAMILY is the address (and protocol) family for the
2660 service specified by HOST and SERVICE. The default (nil) is to use
2661 whatever address family (IPv4 or IPv6) that is defined for the host
2662 and port number specified by HOST and SERVICE. Other address families
2663 supported are:
2664 local -- for a local (i.e. UNIX) address specified by SERVICE.
2665 ipv4 -- use IPv4 address family only.
2666 ipv6 -- use IPv6 address family only.
2668 :local ADDRESS -- ADDRESS is the local address used for the connection.
2669 This parameter is ignored when opening a client process. When specified
2670 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2672 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2673 connection. This parameter is ignored when opening a stream server
2674 process. For a datagram server process, it specifies the initial
2675 setting of the remote datagram address. When specified for a client
2676 process, the FAMILY, HOST, and SERVICE args are ignored.
2678 The format of ADDRESS depends on the address family:
2679 - An IPv4 address is represented as an vector of integers [A B C D P]
2680 corresponding to numeric IP address A.B.C.D and port number P.
2681 - A local address is represented as a string with the address in the
2682 local address space.
2683 - An "unsupported family" address is represented by a cons (F . AV)
2684 where F is the family number and AV is a vector containing the socket
2685 address data with one element per address data byte. Do not rely on
2686 this format in portable code, as it may depend on implementation
2687 defined constants, data sizes, and data structure alignment.
2689 :coding CODING -- If CODING is a symbol, it specifies the coding
2690 system used for both reading and writing for this process. If CODING
2691 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2692 ENCODING is used for writing.
2694 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2695 return without waiting for the connection to complete; instead, the
2696 sentinel function will be called with second arg matching "open" (if
2697 successful) or "failed" when the connect completes. Default is to use
2698 a blocking connect (i.e. wait) for stream type connections.
2700 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2701 running when Emacs is exited.
2703 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2704 In the stopped state, a server process does not accept new
2705 connections, and a client process does not handle incoming traffic.
2706 The stopped state is cleared by `continue-process' and set by
2707 `stop-process'.
2709 :filter FILTER -- Install FILTER as the process filter.
2711 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2712 process filter are multibyte, otherwise they are unibyte.
2713 If this keyword is not specified, the strings are multibyte if
2714 the default value of `enable-multibyte-characters' is non-nil.
2716 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2718 :log LOG -- Install LOG as the server process log function. This
2719 function is called when the server accepts a network connection from a
2720 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2721 is the server process, CLIENT is the new process for the connection,
2722 and MESSAGE is a string.
2724 :plist PLIST -- Install PLIST as the new process' initial plist.
2726 :server QLEN -- if QLEN is non-nil, create a server process for the
2727 specified FAMILY, SERVICE, and connection type (stream or datagram).
2728 If QLEN is an integer, it is used as the max. length of the server's
2729 pending connection queue (also known as the backlog); the default
2730 queue length is 5. Default is to create a client process.
2732 The following network options can be specified for this connection:
2734 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2735 :dontroute BOOL -- Only send to directly connected hosts.
2736 :keepalive BOOL -- Send keep-alive messages on network stream.
2737 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2738 :oobinline BOOL -- Place out-of-band data in receive data stream.
2739 :priority INT -- Set protocol defined priority for sent packets.
2740 :reuseaddr BOOL -- Allow reusing a recently used local address
2741 (this is allowed by default for a server process).
2742 :bindtodevice NAME -- bind to interface NAME. Using this may require
2743 special privileges on some systems.
2745 Consult the relevant system programmer's manual pages for more
2746 information on using these options.
2749 A server process will listen for and accept connections from clients.
2750 When a client connection is accepted, a new network process is created
2751 for the connection with the following parameters:
2753 - The client's process name is constructed by concatenating the server
2754 process' NAME and a client identification string.
2755 - If the FILTER argument is non-nil, the client process will not get a
2756 separate process buffer; otherwise, the client's process buffer is a newly
2757 created buffer named after the server process' BUFFER name or process
2758 NAME concatenated with the client identification string.
2759 - The connection type and the process filter and sentinel parameters are
2760 inherited from the server process' TYPE, FILTER and SENTINEL.
2761 - The client process' contact info is set according to the client's
2762 addressing information (typically an IP address and a port number).
2763 - The client process' plist is initialized from the server's plist.
2765 Notice that the FILTER and SENTINEL args are never used directly by
2766 the server process. Also, the BUFFER argument is not used directly by
2767 the server process, but via the optional :log function, accepted (and
2768 failed) connections may be logged in the server process' buffer.
2770 The original argument list, modified with the actual connection
2771 information, is available via the `process-contact' function.
2773 usage: (make-network-process &rest ARGS) */)
2774 (ptrdiff_t nargs, Lisp_Object *args)
2776 Lisp_Object proc;
2777 Lisp_Object contact;
2778 struct Lisp_Process *p;
2779 #ifdef HAVE_GETADDRINFO
2780 struct addrinfo ai, *res, *lres;
2781 struct addrinfo hints;
2782 const char *portstring;
2783 char portbuf[128];
2784 #else /* HAVE_GETADDRINFO */
2785 struct _emacs_addrinfo
2787 int ai_family;
2788 int ai_socktype;
2789 int ai_protocol;
2790 int ai_addrlen;
2791 struct sockaddr *ai_addr;
2792 struct _emacs_addrinfo *ai_next;
2793 } ai, *res, *lres;
2794 #endif /* HAVE_GETADDRINFO */
2795 struct sockaddr_in address_in;
2796 #ifdef HAVE_LOCAL_SOCKETS
2797 struct sockaddr_un address_un;
2798 #endif
2799 int port;
2800 int ret = 0;
2801 int xerrno = 0;
2802 int s = -1, outch, inch;
2803 struct gcpro gcpro1;
2804 ptrdiff_t count = SPECPDL_INDEX ();
2805 ptrdiff_t count1;
2806 Lisp_Object QCaddress; /* one of QClocal or QCremote */
2807 Lisp_Object tem;
2808 Lisp_Object name, buffer, host, service, address;
2809 Lisp_Object filter, sentinel;
2810 bool is_non_blocking_client = 0;
2811 bool is_server = 0;
2812 int backlog = 5;
2813 int socktype;
2814 int family = -1;
2816 if (nargs == 0)
2817 return Qnil;
2819 /* Save arguments for process-contact and clone-process. */
2820 contact = Flist (nargs, args);
2821 GCPRO1 (contact);
2823 #ifdef WINDOWSNT
2824 /* Ensure socket support is loaded if available. */
2825 init_winsock (TRUE);
2826 #endif
2828 /* :type TYPE (nil: stream, datagram */
2829 tem = Fplist_get (contact, QCtype);
2830 if (NILP (tem))
2831 socktype = SOCK_STREAM;
2832 #ifdef DATAGRAM_SOCKETS
2833 else if (EQ (tem, Qdatagram))
2834 socktype = SOCK_DGRAM;
2835 #endif
2836 #ifdef HAVE_SEQPACKET
2837 else if (EQ (tem, Qseqpacket))
2838 socktype = SOCK_SEQPACKET;
2839 #endif
2840 else
2841 error ("Unsupported connection type");
2843 /* :server BOOL */
2844 tem = Fplist_get (contact, QCserver);
2845 if (!NILP (tem))
2847 /* Don't support network sockets when non-blocking mode is
2848 not available, since a blocked Emacs is not useful. */
2849 is_server = 1;
2850 if (TYPE_RANGED_INTEGERP (int, tem))
2851 backlog = XINT (tem);
2854 /* Make QCaddress an alias for :local (server) or :remote (client). */
2855 QCaddress = is_server ? QClocal : QCremote;
2857 /* :nowait BOOL */
2858 if (!is_server && socktype != SOCK_DGRAM
2859 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
2861 #ifndef NON_BLOCKING_CONNECT
2862 error ("Non-blocking connect not supported");
2863 #else
2864 is_non_blocking_client = 1;
2865 #endif
2868 name = Fplist_get (contact, QCname);
2869 buffer = Fplist_get (contact, QCbuffer);
2870 filter = Fplist_get (contact, QCfilter);
2871 sentinel = Fplist_get (contact, QCsentinel);
2873 CHECK_STRING (name);
2875 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2876 ai.ai_socktype = socktype;
2877 ai.ai_protocol = 0;
2878 ai.ai_next = NULL;
2879 res = &ai;
2881 /* :local ADDRESS or :remote ADDRESS */
2882 address = Fplist_get (contact, QCaddress);
2883 if (!NILP (address))
2885 host = service = Qnil;
2887 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2888 error ("Malformed :address");
2889 ai.ai_family = family;
2890 ai.ai_addr = alloca (ai.ai_addrlen);
2891 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2892 goto open_socket;
2895 /* :family FAMILY -- nil (for Inet), local, or integer. */
2896 tem = Fplist_get (contact, QCfamily);
2897 if (NILP (tem))
2899 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
2900 family = AF_UNSPEC;
2901 #else
2902 family = AF_INET;
2903 #endif
2905 #ifdef HAVE_LOCAL_SOCKETS
2906 else if (EQ (tem, Qlocal))
2907 family = AF_LOCAL;
2908 #endif
2909 #ifdef AF_INET6
2910 else if (EQ (tem, Qipv6))
2911 family = AF_INET6;
2912 #endif
2913 else if (EQ (tem, Qipv4))
2914 family = AF_INET;
2915 else if (TYPE_RANGED_INTEGERP (int, tem))
2916 family = XINT (tem);
2917 else
2918 error ("Unknown address family");
2920 ai.ai_family = family;
2922 /* :service SERVICE -- string, integer (port number), or t (random port). */
2923 service = Fplist_get (contact, QCservice);
2925 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2926 host = Fplist_get (contact, QChost);
2927 if (!NILP (host))
2929 if (EQ (host, Qlocal))
2930 /* Depending on setup, "localhost" may map to different IPv4 and/or
2931 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
2932 host = build_string ("127.0.0.1");
2933 CHECK_STRING (host);
2936 #ifdef HAVE_LOCAL_SOCKETS
2937 if (family == AF_LOCAL)
2939 if (!NILP (host))
2941 message (":family local ignores the :host \"%s\" property",
2942 SDATA (host));
2943 contact = Fplist_put (contact, QChost, Qnil);
2944 host = Qnil;
2946 CHECK_STRING (service);
2947 memset (&address_un, 0, sizeof address_un);
2948 address_un.sun_family = AF_LOCAL;
2949 if (sizeof address_un.sun_path <= SBYTES (service))
2950 error ("Service name too long");
2951 strcpy (address_un.sun_path, SSDATA (service));
2952 ai.ai_addr = (struct sockaddr *) &address_un;
2953 ai.ai_addrlen = sizeof address_un;
2954 goto open_socket;
2956 #endif
2958 /* Slow down polling to every ten seconds.
2959 Some kernels have a bug which causes retrying connect to fail
2960 after a connect. Polling can interfere with gethostbyname too. */
2961 #ifdef POLL_FOR_INPUT
2962 if (socktype != SOCK_DGRAM)
2964 record_unwind_protect_void (run_all_atimers);
2965 bind_polling_period (10);
2967 #endif
2969 #ifdef HAVE_GETADDRINFO
2970 /* If we have a host, use getaddrinfo to resolve both host and service.
2971 Otherwise, use getservbyname to lookup the service. */
2972 if (!NILP (host))
2975 /* SERVICE can either be a string or int.
2976 Convert to a C string for later use by getaddrinfo. */
2977 if (EQ (service, Qt))
2978 portstring = "0";
2979 else if (INTEGERP (service))
2981 sprintf (portbuf, "%"pI"d", XINT (service));
2982 portstring = portbuf;
2984 else
2986 CHECK_STRING (service);
2987 portstring = SSDATA (service);
2990 immediate_quit = 1;
2991 QUIT;
2992 memset (&hints, 0, sizeof (hints));
2993 hints.ai_flags = 0;
2994 hints.ai_family = family;
2995 hints.ai_socktype = socktype;
2996 hints.ai_protocol = 0;
2998 #ifdef HAVE_RES_INIT
2999 res_init ();
3000 #endif
3002 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
3003 if (ret)
3004 #ifdef HAVE_GAI_STRERROR
3005 error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
3006 #else
3007 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
3008 #endif
3009 immediate_quit = 0;
3011 goto open_socket;
3013 #endif /* HAVE_GETADDRINFO */
3015 /* We end up here if getaddrinfo is not defined, or in case no hostname
3016 has been specified (e.g. for a local server process). */
3018 if (EQ (service, Qt))
3019 port = 0;
3020 else if (INTEGERP (service))
3021 port = htons ((unsigned short) XINT (service));
3022 else
3024 struct servent *svc_info;
3025 CHECK_STRING (service);
3026 svc_info = getservbyname (SSDATA (service),
3027 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
3028 if (svc_info == 0)
3029 error ("Unknown service: %s", SDATA (service));
3030 port = svc_info->s_port;
3033 memset (&address_in, 0, sizeof address_in);
3034 address_in.sin_family = family;
3035 address_in.sin_addr.s_addr = INADDR_ANY;
3036 address_in.sin_port = port;
3038 #ifndef HAVE_GETADDRINFO
3039 if (!NILP (host))
3041 struct hostent *host_info_ptr;
3043 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3044 as it may `hang' Emacs for a very long time. */
3045 immediate_quit = 1;
3046 QUIT;
3048 #ifdef HAVE_RES_INIT
3049 res_init ();
3050 #endif
3052 host_info_ptr = gethostbyname (SDATA (host));
3053 immediate_quit = 0;
3055 if (host_info_ptr)
3057 memcpy (&address_in.sin_addr, host_info_ptr->h_addr,
3058 host_info_ptr->h_length);
3059 family = host_info_ptr->h_addrtype;
3060 address_in.sin_family = family;
3062 else
3063 /* Attempt to interpret host as numeric inet address */
3065 unsigned long numeric_addr;
3066 numeric_addr = inet_addr (SSDATA (host));
3067 if (numeric_addr == -1)
3068 error ("Unknown host \"%s\"", SDATA (host));
3070 memcpy (&address_in.sin_addr, &numeric_addr,
3071 sizeof (address_in.sin_addr));
3075 #endif /* not HAVE_GETADDRINFO */
3077 ai.ai_family = family;
3078 ai.ai_addr = (struct sockaddr *) &address_in;
3079 ai.ai_addrlen = sizeof address_in;
3081 open_socket:
3083 /* Do this in case we never enter the for-loop below. */
3084 count1 = SPECPDL_INDEX ();
3085 s = -1;
3087 for (lres = res; lres; lres = lres->ai_next)
3089 ptrdiff_t optn;
3090 int optbits;
3092 #ifdef WINDOWSNT
3093 retry_connect:
3094 #endif
3096 s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC,
3097 lres->ai_protocol);
3098 if (s < 0)
3100 xerrno = errno;
3101 continue;
3104 #ifdef DATAGRAM_SOCKETS
3105 if (!is_server && socktype == SOCK_DGRAM)
3106 break;
3107 #endif /* DATAGRAM_SOCKETS */
3109 #ifdef NON_BLOCKING_CONNECT
3110 if (is_non_blocking_client)
3112 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3113 if (ret < 0)
3115 xerrno = errno;
3116 emacs_close (s);
3117 s = -1;
3118 continue;
3121 #endif
3123 /* Make us close S if quit. */
3124 record_unwind_protect_int (close_file_unwind, s);
3126 /* Parse network options in the arg list.
3127 We simply ignore anything which isn't a known option (including other keywords).
3128 An error is signaled if setting a known option fails. */
3129 for (optn = optbits = 0; optn < nargs-1; optn += 2)
3130 optbits |= set_socket_option (s, args[optn], args[optn+1]);
3132 if (is_server)
3134 /* Configure as a server socket. */
3136 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3137 explicit :reuseaddr key to override this. */
3138 #ifdef HAVE_LOCAL_SOCKETS
3139 if (family != AF_LOCAL)
3140 #endif
3141 if (!(optbits & (1 << OPIX_REUSEADDR)))
3143 int optval = 1;
3144 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3145 report_file_error ("Cannot set reuse option on server socket", Qnil);
3148 if (bind (s, lres->ai_addr, lres->ai_addrlen))
3149 report_file_error ("Cannot bind server socket", Qnil);
3151 #ifdef HAVE_GETSOCKNAME
3152 if (EQ (service, Qt))
3154 struct sockaddr_in sa1;
3155 socklen_t len1 = sizeof (sa1);
3156 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3158 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3159 service = make_number (ntohs (sa1.sin_port));
3160 contact = Fplist_put (contact, QCservice, service);
3163 #endif
3165 if (socktype != SOCK_DGRAM && listen (s, backlog))
3166 report_file_error ("Cannot listen on server socket", Qnil);
3168 break;
3171 immediate_quit = 1;
3172 QUIT;
3174 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
3175 xerrno = errno;
3177 if (ret == 0 || xerrno == EISCONN)
3179 /* The unwind-protect will be discarded afterwards.
3180 Likewise for immediate_quit. */
3181 break;
3184 #ifdef NON_BLOCKING_CONNECT
3185 #ifdef EINPROGRESS
3186 if (is_non_blocking_client && xerrno == EINPROGRESS)
3187 break;
3188 #else
3189 #ifdef EWOULDBLOCK
3190 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
3191 break;
3192 #endif
3193 #endif
3194 #endif
3196 #ifndef WINDOWSNT
3197 if (xerrno == EINTR)
3199 /* Unlike most other syscalls connect() cannot be called
3200 again. (That would return EALREADY.) The proper way to
3201 wait for completion is pselect(). */
3202 int sc;
3203 socklen_t len;
3204 SELECT_TYPE fdset;
3205 retry_select:
3206 FD_ZERO (&fdset);
3207 FD_SET (s, &fdset);
3208 QUIT;
3209 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3210 if (sc == -1)
3212 if (errno == EINTR)
3213 goto retry_select;
3214 else
3215 report_file_error ("Failed select", Qnil);
3217 eassert (sc > 0);
3219 len = sizeof xerrno;
3220 eassert (FD_ISSET (s, &fdset));
3221 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3222 report_file_error ("Failed getsockopt", Qnil);
3223 if (xerrno)
3224 report_file_errno ("Failed connect", Qnil, xerrno);
3225 break;
3227 #endif /* !WINDOWSNT */
3229 immediate_quit = 0;
3231 /* Discard the unwind protect closing S. */
3232 specpdl_ptr = specpdl + count1;
3233 emacs_close (s);
3234 s = -1;
3236 #ifdef WINDOWSNT
3237 if (xerrno == EINTR)
3238 goto retry_connect;
3239 #endif
3242 if (s >= 0)
3244 #ifdef DATAGRAM_SOCKETS
3245 if (socktype == SOCK_DGRAM)
3247 if (datagram_address[s].sa)
3248 emacs_abort ();
3249 datagram_address[s].sa = xmalloc (lres->ai_addrlen);
3250 datagram_address[s].len = lres->ai_addrlen;
3251 if (is_server)
3253 Lisp_Object remote;
3254 memset (datagram_address[s].sa, 0, lres->ai_addrlen);
3255 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3257 int rfamily, rlen;
3258 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3259 if (rlen != 0 && rfamily == lres->ai_family
3260 && rlen == lres->ai_addrlen)
3261 conv_lisp_to_sockaddr (rfamily, remote,
3262 datagram_address[s].sa, rlen);
3265 else
3266 memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
3268 #endif
3269 contact = Fplist_put (contact, QCaddress,
3270 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3271 #ifdef HAVE_GETSOCKNAME
3272 if (!is_server)
3274 struct sockaddr_in sa1;
3275 socklen_t len1 = sizeof (sa1);
3276 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3277 contact = Fplist_put (contact, QClocal,
3278 conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
3280 #endif
3283 immediate_quit = 0;
3285 #ifdef HAVE_GETADDRINFO
3286 if (res != &ai)
3288 block_input ();
3289 freeaddrinfo (res);
3290 unblock_input ();
3292 #endif
3294 /* Discard the unwind protect for closing S, if any. */
3295 specpdl_ptr = specpdl + count1;
3297 /* Unwind bind_polling_period and request_sigio. */
3298 unbind_to (count, Qnil);
3300 if (s < 0)
3302 /* If non-blocking got this far - and failed - assume non-blocking is
3303 not supported after all. This is probably a wrong assumption, but
3304 the normal blocking calls to open-network-stream handles this error
3305 better. */
3306 if (is_non_blocking_client)
3307 return Qnil;
3309 report_file_errno ((is_server
3310 ? "make server process failed"
3311 : "make client process failed"),
3312 contact, xerrno);
3315 inch = s;
3316 outch = s;
3318 if (!NILP (buffer))
3319 buffer = Fget_buffer_create (buffer);
3320 proc = make_process (name);
3322 chan_process[inch] = proc;
3324 fcntl (inch, F_SETFL, O_NONBLOCK);
3326 p = XPROCESS (proc);
3328 pset_childp (p, contact);
3329 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3330 pset_type (p, Qnetwork);
3332 pset_buffer (p, buffer);
3333 pset_sentinel (p, sentinel);
3334 pset_filter (p, filter);
3335 pset_log (p, Fplist_get (contact, QClog));
3336 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3337 p->kill_without_query = 1;
3338 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3339 pset_command (p, Qt);
3340 p->pid = 0;
3341 p->infd = inch;
3342 p->outfd = outch;
3343 if (is_server && socktype != SOCK_DGRAM)
3344 pset_status (p, Qlisten);
3346 /* Make the process marker point into the process buffer (if any). */
3347 if (BUFFERP (buffer))
3348 set_marker_both (p->mark, buffer,
3349 BUF_ZV (XBUFFER (buffer)),
3350 BUF_ZV_BYTE (XBUFFER (buffer)));
3352 #ifdef NON_BLOCKING_CONNECT
3353 if (is_non_blocking_client)
3355 /* We may get here if connect did succeed immediately. However,
3356 in that case, we still need to signal this like a non-blocking
3357 connection. */
3358 pset_status (p, Qconnect);
3359 if (!FD_ISSET (inch, &connect_wait_mask))
3361 FD_SET (inch, &connect_wait_mask);
3362 FD_SET (inch, &write_mask);
3363 num_pending_connects++;
3366 else
3367 #endif
3368 /* A server may have a client filter setting of Qt, but it must
3369 still listen for incoming connects unless it is stopped. */
3370 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3371 || (EQ (p->status, Qlisten) && NILP (p->command)))
3373 FD_SET (inch, &input_wait_mask);
3374 FD_SET (inch, &non_keyboard_wait_mask);
3377 if (inch > max_process_desc)
3378 max_process_desc = inch;
3380 tem = Fplist_member (contact, QCcoding);
3381 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3382 tem = Qnil; /* No error message (too late!). */
3385 /* Setup coding systems for communicating with the network stream. */
3386 struct gcpro gcpro1;
3387 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3388 Lisp_Object coding_systems = Qt;
3389 Lisp_Object fargs[5], val;
3391 if (!NILP (tem))
3393 val = XCAR (XCDR (tem));
3394 if (CONSP (val))
3395 val = XCAR (val);
3397 else if (!NILP (Vcoding_system_for_read))
3398 val = Vcoding_system_for_read;
3399 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3400 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3401 /* We dare not decode end-of-line format by setting VAL to
3402 Qraw_text, because the existing Emacs Lisp libraries
3403 assume that they receive bare code including a sequence of
3404 CR LF. */
3405 val = Qnil;
3406 else
3408 if (NILP (host) || NILP (service))
3409 coding_systems = Qnil;
3410 else
3412 fargs[0] = Qopen_network_stream, fargs[1] = name,
3413 fargs[2] = buffer, fargs[3] = host, fargs[4] = service;
3414 GCPRO1 (proc);
3415 coding_systems = Ffind_operation_coding_system (5, fargs);
3416 UNGCPRO;
3418 if (CONSP (coding_systems))
3419 val = XCAR (coding_systems);
3420 else if (CONSP (Vdefault_process_coding_system))
3421 val = XCAR (Vdefault_process_coding_system);
3422 else
3423 val = Qnil;
3425 pset_decode_coding_system (p, val);
3427 if (!NILP (tem))
3429 val = XCAR (XCDR (tem));
3430 if (CONSP (val))
3431 val = XCDR (val);
3433 else if (!NILP (Vcoding_system_for_write))
3434 val = Vcoding_system_for_write;
3435 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3436 val = Qnil;
3437 else
3439 if (EQ (coding_systems, Qt))
3441 if (NILP (host) || NILP (service))
3442 coding_systems = Qnil;
3443 else
3445 fargs[0] = Qopen_network_stream, fargs[1] = name,
3446 fargs[2] = buffer, fargs[3] = host, fargs[4] = service;
3447 GCPRO1 (proc);
3448 coding_systems = Ffind_operation_coding_system (5, fargs);
3449 UNGCPRO;
3452 if (CONSP (coding_systems))
3453 val = XCDR (coding_systems);
3454 else if (CONSP (Vdefault_process_coding_system))
3455 val = XCDR (Vdefault_process_coding_system);
3456 else
3457 val = Qnil;
3459 pset_encode_coding_system (p, val);
3461 setup_process_coding_systems (proc);
3463 pset_decoding_buf (p, empty_unibyte_string);
3464 p->decoding_carryover = 0;
3465 pset_encoding_buf (p, empty_unibyte_string);
3467 p->inherit_coding_system_flag
3468 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3470 UNGCPRO;
3471 return proc;
3475 #if defined (HAVE_NET_IF_H)
3477 #ifdef SIOCGIFCONF
3478 DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
3479 doc: /* Return an alist of all network interfaces and their network address.
3480 Each element is a cons, the car of which is a string containing the
3481 interface name, and the cdr is the network address in internal
3482 format; see the description of ADDRESS in `make-network-process'. */)
3483 (void)
3485 struct ifconf ifconf;
3486 struct ifreq *ifreq;
3487 void *buf = NULL;
3488 ptrdiff_t buf_size = 512;
3489 int s;
3490 Lisp_Object res;
3491 ptrdiff_t count;
3493 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
3494 if (s < 0)
3495 return Qnil;
3496 count = SPECPDL_INDEX ();
3497 record_unwind_protect_int (close_file_unwind, s);
3501 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
3502 ifconf.ifc_buf = buf;
3503 ifconf.ifc_len = buf_size;
3504 if (ioctl (s, SIOCGIFCONF, &ifconf))
3506 emacs_close (s);
3507 xfree (buf);
3508 return Qnil;
3511 while (ifconf.ifc_len == buf_size);
3513 res = unbind_to (count, Qnil);
3514 ifreq = ifconf.ifc_req;
3515 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
3517 struct ifreq *ifq = ifreq;
3518 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3519 #define SIZEOF_IFREQ(sif) \
3520 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3521 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3523 int len = SIZEOF_IFREQ (ifq);
3524 #else
3525 int len = sizeof (*ifreq);
3526 #endif
3527 char namebuf[sizeof (ifq->ifr_name) + 1];
3528 ifreq = (struct ifreq *) ((char *) ifreq + len);
3530 if (ifq->ifr_addr.sa_family != AF_INET)
3531 continue;
3533 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
3534 namebuf[sizeof (ifq->ifr_name)] = 0;
3535 res = Fcons (Fcons (build_string (namebuf),
3536 conv_sockaddr_to_lisp (&ifq->ifr_addr,
3537 sizeof (struct sockaddr))),
3538 res);
3541 xfree (buf);
3542 return res;
3544 #endif /* SIOCGIFCONF */
3546 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
3548 struct ifflag_def {
3549 int flag_bit;
3550 const char *flag_sym;
3553 static const struct ifflag_def ifflag_table[] = {
3554 #ifdef IFF_UP
3555 { IFF_UP, "up" },
3556 #endif
3557 #ifdef IFF_BROADCAST
3558 { IFF_BROADCAST, "broadcast" },
3559 #endif
3560 #ifdef IFF_DEBUG
3561 { IFF_DEBUG, "debug" },
3562 #endif
3563 #ifdef IFF_LOOPBACK
3564 { IFF_LOOPBACK, "loopback" },
3565 #endif
3566 #ifdef IFF_POINTOPOINT
3567 { IFF_POINTOPOINT, "pointopoint" },
3568 #endif
3569 #ifdef IFF_RUNNING
3570 { IFF_RUNNING, "running" },
3571 #endif
3572 #ifdef IFF_NOARP
3573 { IFF_NOARP, "noarp" },
3574 #endif
3575 #ifdef IFF_PROMISC
3576 { IFF_PROMISC, "promisc" },
3577 #endif
3578 #ifdef IFF_NOTRAILERS
3579 #ifdef NS_IMPL_COCOA
3580 /* Really means smart, notrailers is obsolete */
3581 { IFF_NOTRAILERS, "smart" },
3582 #else
3583 { IFF_NOTRAILERS, "notrailers" },
3584 #endif
3585 #endif
3586 #ifdef IFF_ALLMULTI
3587 { IFF_ALLMULTI, "allmulti" },
3588 #endif
3589 #ifdef IFF_MASTER
3590 { IFF_MASTER, "master" },
3591 #endif
3592 #ifdef IFF_SLAVE
3593 { IFF_SLAVE, "slave" },
3594 #endif
3595 #ifdef IFF_MULTICAST
3596 { IFF_MULTICAST, "multicast" },
3597 #endif
3598 #ifdef IFF_PORTSEL
3599 { IFF_PORTSEL, "portsel" },
3600 #endif
3601 #ifdef IFF_AUTOMEDIA
3602 { IFF_AUTOMEDIA, "automedia" },
3603 #endif
3604 #ifdef IFF_DYNAMIC
3605 { IFF_DYNAMIC, "dynamic" },
3606 #endif
3607 #ifdef IFF_OACTIVE
3608 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress */
3609 #endif
3610 #ifdef IFF_SIMPLEX
3611 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions */
3612 #endif
3613 #ifdef IFF_LINK0
3614 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit */
3615 #endif
3616 #ifdef IFF_LINK1
3617 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit */
3618 #endif
3619 #ifdef IFF_LINK2
3620 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit */
3621 #endif
3622 { 0, 0 }
3625 DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
3626 doc: /* Return information about network interface named IFNAME.
3627 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3628 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3629 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
3630 FLAGS is the current flags of the interface. */)
3631 (Lisp_Object ifname)
3633 struct ifreq rq;
3634 Lisp_Object res = Qnil;
3635 Lisp_Object elt;
3636 int s;
3637 bool any = 0;
3638 ptrdiff_t count;
3639 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3640 && defined HAVE_GETIFADDRS && defined LLADDR)
3641 struct ifaddrs *ifap;
3642 #endif
3644 CHECK_STRING (ifname);
3646 if (sizeof rq.ifr_name <= SBYTES (ifname))
3647 error ("interface name too long");
3648 strcpy (rq.ifr_name, SSDATA (ifname));
3650 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
3651 if (s < 0)
3652 return Qnil;
3653 count = SPECPDL_INDEX ();
3654 record_unwind_protect_int (close_file_unwind, s);
3656 elt = Qnil;
3657 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
3658 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
3660 int flags = rq.ifr_flags;
3661 const struct ifflag_def *fp;
3662 int fnum;
3664 /* If flags is smaller than int (i.e. short) it may have the high bit set
3665 due to IFF_MULTICAST. In that case, sign extending it into
3666 an int is wrong. */
3667 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
3668 flags = (unsigned short) rq.ifr_flags;
3670 any = 1;
3671 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
3673 if (flags & fp->flag_bit)
3675 elt = Fcons (intern (fp->flag_sym), elt);
3676 flags -= fp->flag_bit;
3679 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
3681 if (flags & 1)
3683 elt = Fcons (make_number (fnum), elt);
3687 #endif
3688 res = Fcons (elt, res);
3690 elt = Qnil;
3691 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
3692 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
3694 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
3695 register struct Lisp_Vector *p = XVECTOR (hwaddr);
3696 int n;
3698 any = 1;
3699 for (n = 0; n < 6; n++)
3700 p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
3701 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
3703 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
3704 if (getifaddrs (&ifap) != -1)
3706 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
3707 register struct Lisp_Vector *p = XVECTOR (hwaddr);
3708 struct ifaddrs *it;
3710 for (it = ifap; it != NULL; it = it->ifa_next)
3712 struct sockaddr_dl *sdl = (struct sockaddr_dl*) it->ifa_addr;
3713 unsigned char linkaddr[6];
3714 int n;
3716 if (it->ifa_addr->sa_family != AF_LINK
3717 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
3718 || sdl->sdl_alen != 6)
3719 continue;
3721 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
3722 for (n = 0; n < 6; n++)
3723 p->contents[n] = make_number (linkaddr[n]);
3725 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
3726 break;
3729 #ifdef HAVE_FREEIFADDRS
3730 freeifaddrs (ifap);
3731 #endif
3733 #endif /* HAVE_GETIFADDRS && LLADDR */
3735 res = Fcons (elt, res);
3737 elt = Qnil;
3738 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
3739 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
3741 any = 1;
3742 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3743 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
3744 #else
3745 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3746 #endif
3748 #endif
3749 res = Fcons (elt, res);
3751 elt = Qnil;
3752 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3753 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
3755 any = 1;
3756 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
3758 #endif
3759 res = Fcons (elt, res);
3761 elt = Qnil;
3762 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
3763 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
3765 any = 1;
3766 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3768 #endif
3769 res = Fcons (elt, res);
3771 return unbind_to (count, any ? res : Qnil);
3773 #endif
3774 #endif /* defined (HAVE_NET_IF_H) */
3776 /* Turn off input and output for process PROC. */
3778 static void
3779 deactivate_process (Lisp_Object proc)
3781 register int inchannel, outchannel;
3782 register struct Lisp_Process *p = XPROCESS (proc);
3784 #ifdef HAVE_GNUTLS
3785 /* Delete GnuTLS structures in PROC, if any. */
3786 emacs_gnutls_deinit (proc);
3787 #endif /* HAVE_GNUTLS */
3789 inchannel = p->infd;
3790 outchannel = p->outfd;
3792 #ifdef ADAPTIVE_READ_BUFFERING
3793 if (p->read_output_delay > 0)
3795 if (--process_output_delay_count < 0)
3796 process_output_delay_count = 0;
3797 p->read_output_delay = 0;
3798 p->read_output_skip = 0;
3800 #endif
3802 if (inchannel >= 0)
3804 /* Beware SIGCHLD hereabouts. */
3805 flush_pending_output (inchannel);
3806 emacs_close (inchannel);
3807 if (outchannel >= 0 && outchannel != inchannel)
3808 emacs_close (outchannel);
3810 p->infd = -1;
3811 p->outfd = -1;
3812 #ifdef DATAGRAM_SOCKETS
3813 if (DATAGRAM_CHAN_P (inchannel))
3815 xfree (datagram_address[inchannel].sa);
3816 datagram_address[inchannel].sa = 0;
3817 datagram_address[inchannel].len = 0;
3819 #endif
3820 chan_process[inchannel] = Qnil;
3821 FD_CLR (inchannel, &input_wait_mask);
3822 FD_CLR (inchannel, &non_keyboard_wait_mask);
3823 #ifdef NON_BLOCKING_CONNECT
3824 if (FD_ISSET (inchannel, &connect_wait_mask))
3826 FD_CLR (inchannel, &connect_wait_mask);
3827 FD_CLR (inchannel, &write_mask);
3828 if (--num_pending_connects < 0)
3829 emacs_abort ();
3831 #endif
3832 if (inchannel == max_process_desc)
3834 int i;
3835 /* We just closed the highest-numbered process input descriptor,
3836 so recompute the highest-numbered one now. */
3837 max_process_desc = 0;
3838 for (i = 0; i < MAXDESC; i++)
3839 if (!NILP (chan_process[i]))
3840 max_process_desc = i;
3846 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
3847 0, 4, 0,
3848 doc: /* Allow any pending output from subprocesses to be read by Emacs.
3849 It is read into the process' buffers or given to their filter functions.
3850 Non-nil arg PROCESS means do not return until some output has been received
3851 from PROCESS.
3853 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3854 and milliseconds to wait; return after that much time whether or not
3855 there is any subprocess output. If SECONDS is a floating point number,
3856 it specifies a fractional number of seconds to wait.
3857 The MILLISEC argument is obsolete and should be avoided.
3859 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3860 from PROCESS, suspending reading output from other processes.
3861 If JUST-THIS-ONE is an integer, don't run any timers either.
3862 Return non-nil if we received any output before the timeout expired. */)
3863 (register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one)
3865 intmax_t secs;
3866 int nsecs;
3868 if (! NILP (process))
3869 CHECK_PROCESS (process);
3870 else
3871 just_this_one = Qnil;
3873 if (!NILP (millisec))
3874 { /* Obsolete calling convention using integers rather than floats. */
3875 CHECK_NUMBER (millisec);
3876 if (NILP (seconds))
3877 seconds = make_float (XINT (millisec) / 1000.0);
3878 else
3880 CHECK_NUMBER (seconds);
3881 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
3885 secs = 0;
3886 nsecs = -1;
3888 if (!NILP (seconds))
3890 if (INTEGERP (seconds))
3892 if (XINT (seconds) > 0)
3894 secs = XINT (seconds);
3895 nsecs = 0;
3898 else if (FLOATP (seconds))
3900 if (XFLOAT_DATA (seconds) > 0)
3902 EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds));
3903 secs = min (EMACS_SECS (t), WAIT_READING_MAX);
3904 nsecs = EMACS_NSECS (t);
3907 else
3908 wrong_type_argument (Qnumberp, seconds);
3910 else if (! NILP (process))
3911 nsecs = 0;
3913 return
3914 (wait_reading_process_output (secs, nsecs, 0, 0,
3915 Qnil,
3916 !NILP (process) ? XPROCESS (process) : NULL,
3917 NILP (just_this_one) ? 0 :
3918 !INTEGERP (just_this_one) ? 1 : -1)
3919 ? Qt : Qnil);
3922 /* Accept a connection for server process SERVER on CHANNEL. */
3924 static EMACS_INT connect_counter = 0;
3926 static void
3927 server_accept_connection (Lisp_Object server, int channel)
3929 Lisp_Object proc, caller, name, buffer;
3930 Lisp_Object contact, host, service;
3931 struct Lisp_Process *ps= XPROCESS (server);
3932 struct Lisp_Process *p;
3933 int s;
3934 union u_sockaddr {
3935 struct sockaddr sa;
3936 struct sockaddr_in in;
3937 #ifdef AF_INET6
3938 struct sockaddr_in6 in6;
3939 #endif
3940 #ifdef HAVE_LOCAL_SOCKETS
3941 struct sockaddr_un un;
3942 #endif
3943 } saddr;
3944 socklen_t len = sizeof saddr;
3945 ptrdiff_t count;
3947 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
3949 if (s < 0)
3951 int code = errno;
3953 if (code == EAGAIN)
3954 return;
3955 #ifdef EWOULDBLOCK
3956 if (code == EWOULDBLOCK)
3957 return;
3958 #endif
3960 if (!NILP (ps->log))
3961 call3 (ps->log, server, Qnil,
3962 concat3 (build_string ("accept failed with code"),
3963 Fnumber_to_string (make_number (code)),
3964 build_string ("\n")));
3965 return;
3968 count = SPECPDL_INDEX ();
3969 record_unwind_protect_int (close_file_unwind, s);
3971 connect_counter++;
3973 /* Setup a new process to handle the connection. */
3975 /* Generate a unique identification of the caller, and build contact
3976 information for this process. */
3977 host = Qt;
3978 service = Qnil;
3979 switch (saddr.sa.sa_family)
3981 case AF_INET:
3983 Lisp_Object args[5];
3984 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
3985 args[0] = build_string ("%d.%d.%d.%d");
3986 args[1] = make_number (*ip++);
3987 args[2] = make_number (*ip++);
3988 args[3] = make_number (*ip++);
3989 args[4] = make_number (*ip++);
3990 host = Fformat (5, args);
3991 service = make_number (ntohs (saddr.in.sin_port));
3993 args[0] = build_string (" <%s:%d>");
3994 args[1] = host;
3995 args[2] = service;
3996 caller = Fformat (3, args);
3998 break;
4000 #ifdef AF_INET6
4001 case AF_INET6:
4003 Lisp_Object args[9];
4004 uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
4005 int i;
4006 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4007 for (i = 0; i < 8; i++)
4008 args[i+1] = make_number (ntohs (ip6[i]));
4009 host = Fformat (9, args);
4010 service = make_number (ntohs (saddr.in.sin_port));
4012 args[0] = build_string (" <[%s]:%d>");
4013 args[1] = host;
4014 args[2] = service;
4015 caller = Fformat (3, args);
4017 break;
4018 #endif
4020 #ifdef HAVE_LOCAL_SOCKETS
4021 case AF_LOCAL:
4022 #endif
4023 default:
4024 caller = Fnumber_to_string (make_number (connect_counter));
4025 caller = concat3 (build_string (" <"), caller, build_string (">"));
4026 break;
4029 /* Create a new buffer name for this process if it doesn't have a
4030 filter. The new buffer name is based on the buffer name or
4031 process name of the server process concatenated with the caller
4032 identification. */
4034 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4035 || EQ (ps->filter, Qt)))
4036 buffer = Qnil;
4037 else
4039 buffer = ps->buffer;
4040 if (!NILP (buffer))
4041 buffer = Fbuffer_name (buffer);
4042 else
4043 buffer = ps->name;
4044 if (!NILP (buffer))
4046 buffer = concat2 (buffer, caller);
4047 buffer = Fget_buffer_create (buffer);
4051 /* Generate a unique name for the new server process. Combine the
4052 server process name with the caller identification. */
4054 name = concat2 (ps->name, caller);
4055 proc = make_process (name);
4057 chan_process[s] = proc;
4059 fcntl (s, F_SETFL, O_NONBLOCK);
4061 p = XPROCESS (proc);
4063 /* Build new contact information for this setup. */
4064 contact = Fcopy_sequence (ps->childp);
4065 contact = Fplist_put (contact, QCserver, Qnil);
4066 contact = Fplist_put (contact, QChost, host);
4067 if (!NILP (service))
4068 contact = Fplist_put (contact, QCservice, service);
4069 contact = Fplist_put (contact, QCremote,
4070 conv_sockaddr_to_lisp (&saddr.sa, len));
4071 #ifdef HAVE_GETSOCKNAME
4072 len = sizeof saddr;
4073 if (getsockname (s, &saddr.sa, &len) == 0)
4074 contact = Fplist_put (contact, QClocal,
4075 conv_sockaddr_to_lisp (&saddr.sa, len));
4076 #endif
4078 pset_childp (p, contact);
4079 pset_plist (p, Fcopy_sequence (ps->plist));
4080 pset_type (p, Qnetwork);
4082 pset_buffer (p, buffer);
4083 pset_sentinel (p, ps->sentinel);
4084 pset_filter (p, ps->filter);
4085 pset_command (p, Qnil);
4086 p->pid = 0;
4088 /* Discard the unwind protect for closing S. */
4089 specpdl_ptr = specpdl + count;
4091 p->infd = s;
4092 p->outfd = s;
4093 pset_status (p, Qrun);
4095 /* Client processes for accepted connections are not stopped initially. */
4096 if (!EQ (p->filter, Qt))
4098 FD_SET (s, &input_wait_mask);
4099 FD_SET (s, &non_keyboard_wait_mask);
4102 if (s > max_process_desc)
4103 max_process_desc = s;
4105 /* Setup coding system for new process based on server process.
4106 This seems to be the proper thing to do, as the coding system
4107 of the new process should reflect the settings at the time the
4108 server socket was opened; not the current settings. */
4110 pset_decode_coding_system (p, ps->decode_coding_system);
4111 pset_encode_coding_system (p, ps->encode_coding_system);
4112 setup_process_coding_systems (proc);
4114 pset_decoding_buf (p, empty_unibyte_string);
4115 p->decoding_carryover = 0;
4116 pset_encoding_buf (p, empty_unibyte_string);
4118 p->inherit_coding_system_flag
4119 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4121 if (!NILP (ps->log))
4122 call3 (ps->log, server, proc,
4123 concat3 (build_string ("accept from "),
4124 (STRINGP (host) ? host : build_string ("-")),
4125 build_string ("\n")));
4127 exec_sentinel (proc,
4128 concat3 (build_string ("open from "),
4129 (STRINGP (host) ? host : build_string ("-")),
4130 build_string ("\n")));
4133 /* This variable is different from waiting_for_input in keyboard.c.
4134 It is used to communicate to a lisp process-filter/sentinel (via the
4135 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4136 for user-input when that process-filter was called.
4137 waiting_for_input cannot be used as that is by definition 0 when
4138 lisp code is being evalled.
4139 This is also used in record_asynch_buffer_change.
4140 For that purpose, this must be 0
4141 when not inside wait_reading_process_output. */
4142 static int waiting_for_user_input_p;
4144 static void
4145 wait_reading_process_output_unwind (int data)
4147 waiting_for_user_input_p = data;
4150 /* This is here so breakpoints can be put on it. */
4151 static void
4152 wait_reading_process_output_1 (void)
4156 /* Read and dispose of subprocess output while waiting for timeout to
4157 elapse and/or keyboard input to be available.
4159 TIME_LIMIT is:
4160 timeout in seconds
4161 If negative, gobble data immediately available but don't wait for any.
4163 NSECS is:
4164 an additional duration to wait, measured in nanoseconds
4165 If TIME_LIMIT is zero, then:
4166 If NSECS == 0, there is no limit.
4167 If NSECS > 0, the timeout consists of NSECS only.
4168 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4170 READ_KBD is:
4171 0 to ignore keyboard input, or
4172 1 to return when input is available, or
4173 -1 meaning caller will actually read the input, so don't throw to
4174 the quit handler, or
4176 DO_DISPLAY means redisplay should be done to show subprocess
4177 output that arrives.
4179 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4180 (and gobble terminal input into the buffer if any arrives).
4182 If WAIT_PROC is specified, wait until something arrives from that
4183 process. The return value is true if we read some input from
4184 that process.
4186 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4187 (suspending output from other processes). A negative value
4188 means don't run any timers either.
4190 If WAIT_PROC is specified, then the function returns true if we
4191 received input from that process before the timeout elapsed.
4192 Otherwise, return true if we received input from any process. */
4194 bool
4195 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4196 bool do_display,
4197 Lisp_Object wait_for_cell,
4198 struct Lisp_Process *wait_proc, int just_wait_proc)
4200 int channel, nfds;
4201 SELECT_TYPE Available;
4202 SELECT_TYPE Writeok;
4203 bool check_write;
4204 int check_delay;
4205 bool no_avail;
4206 int xerrno;
4207 Lisp_Object proc;
4208 EMACS_TIME timeout, end_time;
4209 int wait_channel = -1;
4210 bool got_some_input = 0;
4211 ptrdiff_t count = SPECPDL_INDEX ();
4213 FD_ZERO (&Available);
4214 FD_ZERO (&Writeok);
4216 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
4217 && !(CONSP (wait_proc->status)
4218 && EQ (XCAR (wait_proc->status), Qexit)))
4219 message1 ("Blocking call to accept-process-output with quit inhibited!!");
4221 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4222 if (wait_proc != NULL)
4223 wait_channel = wait_proc->infd;
4225 record_unwind_protect_int (wait_reading_process_output_unwind,
4226 waiting_for_user_input_p);
4227 waiting_for_user_input_p = read_kbd;
4229 if (time_limit < 0)
4231 time_limit = 0;
4232 nsecs = -1;
4234 else if (TYPE_MAXIMUM (time_t) < time_limit)
4235 time_limit = TYPE_MAXIMUM (time_t);
4237 /* Since we may need to wait several times,
4238 compute the absolute time to return at. */
4239 if (time_limit || nsecs > 0)
4241 timeout = make_emacs_time (time_limit, nsecs);
4242 end_time = add_emacs_time (current_emacs_time (), timeout);
4245 while (1)
4247 bool timeout_reduced_for_timers = 0;
4249 /* If calling from keyboard input, do not quit
4250 since we want to return C-g as an input character.
4251 Otherwise, do pending quit if requested. */
4252 if (read_kbd >= 0)
4253 QUIT;
4254 else if (pending_signals)
4255 process_pending_signals ();
4257 /* Exit now if the cell we're waiting for became non-nil. */
4258 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4259 break;
4261 /* Compute time from now till when time limit is up. */
4262 /* Exit if already run out. */
4263 if (nsecs < 0)
4265 /* A negative timeout means
4266 gobble output available now
4267 but don't wait at all. */
4269 timeout = make_emacs_time (0, 0);
4271 else if (time_limit || nsecs > 0)
4273 EMACS_TIME now = current_emacs_time ();
4274 if (EMACS_TIME_LE (end_time, now))
4275 break;
4276 timeout = sub_emacs_time (end_time, now);
4278 else
4280 timeout = make_emacs_time (100000, 0);
4283 /* Normally we run timers here.
4284 But not if wait_for_cell; in those cases,
4285 the wait is supposed to be short,
4286 and those callers cannot handle running arbitrary Lisp code here. */
4287 if (NILP (wait_for_cell)
4288 && just_wait_proc >= 0)
4290 EMACS_TIME timer_delay;
4294 unsigned old_timers_run = timers_run;
4295 struct buffer *old_buffer = current_buffer;
4296 Lisp_Object old_window = selected_window;
4298 timer_delay = timer_check ();
4300 /* If a timer has run, this might have changed buffers
4301 an alike. Make read_key_sequence aware of that. */
4302 if (timers_run != old_timers_run
4303 && (old_buffer != current_buffer
4304 || !EQ (old_window, selected_window))
4305 && waiting_for_user_input_p == -1)
4306 record_asynch_buffer_change ();
4308 if (timers_run != old_timers_run && do_display)
4309 /* We must retry, since a timer may have requeued itself
4310 and that could alter the time_delay. */
4311 redisplay_preserve_echo_area (9);
4312 else
4313 break;
4315 while (!detect_input_pending ());
4317 /* If there is unread keyboard input, also return. */
4318 if (read_kbd != 0
4319 && requeued_events_pending_p ())
4320 break;
4322 /* A negative timeout means do not wait at all. */
4323 if (nsecs >= 0)
4325 if (EMACS_TIME_VALID_P (timer_delay))
4327 if (EMACS_TIME_LT (timer_delay, timeout))
4329 timeout = timer_delay;
4330 timeout_reduced_for_timers = 1;
4333 else
4335 /* This is so a breakpoint can be put here. */
4336 wait_reading_process_output_1 ();
4341 /* Cause C-g and alarm signals to take immediate action,
4342 and cause input available signals to zero out timeout.
4344 It is important that we do this before checking for process
4345 activity. If we get a SIGCHLD after the explicit checks for
4346 process activity, timeout is the only way we will know. */
4347 if (read_kbd < 0)
4348 set_waiting_for_input (&timeout);
4350 /* If status of something has changed, and no input is
4351 available, notify the user of the change right away. After
4352 this explicit check, we'll let the SIGCHLD handler zap
4353 timeout to get our attention. */
4354 if (update_tick != process_tick)
4356 SELECT_TYPE Atemp;
4357 SELECT_TYPE Ctemp;
4359 if (kbd_on_hold_p ())
4360 FD_ZERO (&Atemp);
4361 else
4362 Atemp = input_wait_mask;
4363 Ctemp = write_mask;
4365 timeout = make_emacs_time (0, 0);
4366 if ((pselect (max (max_process_desc, max_input_desc) + 1,
4367 &Atemp,
4368 #ifdef NON_BLOCKING_CONNECT
4369 (num_pending_connects > 0 ? &Ctemp : NULL),
4370 #else
4371 NULL,
4372 #endif
4373 NULL, &timeout, NULL)
4374 <= 0))
4376 /* It's okay for us to do this and then continue with
4377 the loop, since timeout has already been zeroed out. */
4378 clear_waiting_for_input ();
4379 status_notify (NULL);
4380 if (do_display) redisplay_preserve_echo_area (13);
4384 /* Don't wait for output from a non-running process. Just
4385 read whatever data has already been received. */
4386 if (wait_proc && wait_proc->raw_status_new)
4387 update_status (wait_proc);
4388 if (wait_proc
4389 && ! EQ (wait_proc->status, Qrun)
4390 && ! EQ (wait_proc->status, Qconnect))
4392 bool read_some_bytes = 0;
4394 clear_waiting_for_input ();
4395 XSETPROCESS (proc, wait_proc);
4397 /* Read data from the process, until we exhaust it. */
4398 while (wait_proc->infd >= 0)
4400 int nread = read_process_output (proc, wait_proc->infd);
4402 if (nread == 0)
4403 break;
4405 if (nread > 0)
4406 got_some_input = read_some_bytes = 1;
4407 else if (nread == -1 && (errno == EIO || errno == EAGAIN))
4408 break;
4409 #ifdef EWOULDBLOCK
4410 else if (nread == -1 && EWOULDBLOCK == errno)
4411 break;
4412 #endif
4414 if (read_some_bytes && do_display)
4415 redisplay_preserve_echo_area (10);
4417 break;
4420 /* Wait till there is something to do */
4422 if (wait_proc && just_wait_proc)
4424 if (wait_proc->infd < 0) /* Terminated */
4425 break;
4426 FD_SET (wait_proc->infd, &Available);
4427 check_delay = 0;
4428 check_write = 0;
4430 else if (!NILP (wait_for_cell))
4432 Available = non_process_wait_mask;
4433 check_delay = 0;
4434 check_write = 0;
4436 else
4438 if (! read_kbd)
4439 Available = non_keyboard_wait_mask;
4440 else
4441 Available = input_wait_mask;
4442 Writeok = write_mask;
4443 #ifdef SELECT_CANT_DO_WRITE_MASK
4444 check_write = 0;
4445 #else
4446 check_write = 1;
4447 #endif
4448 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
4451 /* If frame size has changed or the window is newly mapped,
4452 redisplay now, before we start to wait. There is a race
4453 condition here; if a SIGIO arrives between now and the select
4454 and indicates that a frame is trashed, the select may block
4455 displaying a trashed screen. */
4456 if (frame_garbaged && do_display)
4458 clear_waiting_for_input ();
4459 redisplay_preserve_echo_area (11);
4460 if (read_kbd < 0)
4461 set_waiting_for_input (&timeout);
4464 /* Skip the `select' call if input is available and we're
4465 waiting for keyboard input or a cell change (which can be
4466 triggered by processing X events). In the latter case, set
4467 nfds to 1 to avoid breaking the loop. */
4468 no_avail = 0;
4469 if ((read_kbd || !NILP (wait_for_cell))
4470 && detect_input_pending ())
4472 nfds = read_kbd ? 0 : 1;
4473 no_avail = 1;
4476 if (!no_avail)
4479 #ifdef ADAPTIVE_READ_BUFFERING
4480 /* Set the timeout for adaptive read buffering if any
4481 process has non-zero read_output_skip and non-zero
4482 read_output_delay, and we are not reading output for a
4483 specific wait_channel. It is not executed if
4484 Vprocess_adaptive_read_buffering is nil. */
4485 if (process_output_skip && check_delay > 0)
4487 int nsecs = EMACS_NSECS (timeout);
4488 if (EMACS_SECS (timeout) > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
4489 nsecs = READ_OUTPUT_DELAY_MAX;
4490 for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
4492 proc = chan_process[channel];
4493 if (NILP (proc))
4494 continue;
4495 /* Find minimum non-zero read_output_delay among the
4496 processes with non-zero read_output_skip. */
4497 if (XPROCESS (proc)->read_output_delay > 0)
4499 check_delay--;
4500 if (!XPROCESS (proc)->read_output_skip)
4501 continue;
4502 FD_CLR (channel, &Available);
4503 XPROCESS (proc)->read_output_skip = 0;
4504 if (XPROCESS (proc)->read_output_delay < nsecs)
4505 nsecs = XPROCESS (proc)->read_output_delay;
4508 timeout = make_emacs_time (0, nsecs);
4509 process_output_skip = 0;
4511 #endif
4513 #if defined (HAVE_NS)
4514 nfds = ns_select
4515 #elif defined (HAVE_GLIB)
4516 nfds = xg_select
4517 #else
4518 nfds = pselect
4519 #endif
4520 (max (max_process_desc, max_input_desc) + 1,
4521 &Available,
4522 (check_write ? &Writeok : (SELECT_TYPE *)0),
4523 NULL, &timeout, NULL);
4525 #ifdef HAVE_GNUTLS
4526 /* GnuTLS buffers data internally. In lowat mode it leaves
4527 some data in the TCP buffers so that select works, but
4528 with custom pull/push functions we need to check if some
4529 data is available in the buffers manually. */
4530 if (nfds == 0)
4532 if (! wait_proc)
4534 /* We're not waiting on a specific process, so loop
4535 through all the channels and check for data.
4536 This is a workaround needed for some versions of
4537 the gnutls library -- 2.12.14 has been confirmed
4538 to need it. See
4539 http://comments.gmane.org/gmane.emacs.devel/145074 */
4540 for (channel = 0; channel < MAXDESC; ++channel)
4541 if (! NILP (chan_process[channel]))
4543 struct Lisp_Process *p =
4544 XPROCESS (chan_process[channel]);
4545 if (p && p->gnutls_p && p->infd
4546 && ((emacs_gnutls_record_check_pending
4547 (p->gnutls_state))
4548 > 0))
4550 nfds++;
4551 FD_SET (p->infd, &Available);
4555 else
4557 /* Check this specific channel. */
4558 if (wait_proc->gnutls_p /* Check for valid process. */
4559 /* Do we have pending data? */
4560 && ((emacs_gnutls_record_check_pending
4561 (wait_proc->gnutls_state))
4562 > 0))
4564 nfds = 1;
4565 /* Set to Available. */
4566 FD_SET (wait_proc->infd, &Available);
4570 #endif
4573 xerrno = errno;
4575 /* Make C-g and alarm signals set flags again */
4576 clear_waiting_for_input ();
4578 /* If we woke up due to SIGWINCH, actually change size now. */
4579 do_pending_window_change (0);
4581 if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
4582 /* We waited the full specified time, so return now. */
4583 break;
4584 if (nfds < 0)
4586 if (xerrno == EINTR)
4587 no_avail = 1;
4588 else if (xerrno == EBADF)
4589 emacs_abort ();
4590 else
4591 report_file_errno ("Failed select", Qnil, xerrno);
4594 if (no_avail)
4596 FD_ZERO (&Available);
4597 check_write = 0;
4600 /* Check for keyboard input */
4601 /* If there is any, return immediately
4602 to give it higher priority than subprocesses */
4604 if (read_kbd != 0)
4606 unsigned old_timers_run = timers_run;
4607 struct buffer *old_buffer = current_buffer;
4608 Lisp_Object old_window = selected_window;
4609 bool leave = 0;
4611 if (detect_input_pending_run_timers (do_display))
4613 swallow_events (do_display);
4614 if (detect_input_pending_run_timers (do_display))
4615 leave = 1;
4618 /* If a timer has run, this might have changed buffers
4619 an alike. Make read_key_sequence aware of that. */
4620 if (timers_run != old_timers_run
4621 && waiting_for_user_input_p == -1
4622 && (old_buffer != current_buffer
4623 || !EQ (old_window, selected_window)))
4624 record_asynch_buffer_change ();
4626 if (leave)
4627 break;
4630 /* If there is unread keyboard input, also return. */
4631 if (read_kbd != 0
4632 && requeued_events_pending_p ())
4633 break;
4635 /* If we are not checking for keyboard input now,
4636 do process events (but don't run any timers).
4637 This is so that X events will be processed.
4638 Otherwise they may have to wait until polling takes place.
4639 That would causes delays in pasting selections, for example.
4641 (We used to do this only if wait_for_cell.) */
4642 if (read_kbd == 0 && detect_input_pending ())
4644 swallow_events (do_display);
4645 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4646 if (detect_input_pending ())
4647 break;
4648 #endif
4651 /* Exit now if the cell we're waiting for became non-nil. */
4652 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4653 break;
4655 #ifdef USABLE_SIGIO
4656 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4657 go read it. This can happen with X on BSD after logging out.
4658 In that case, there really is no input and no SIGIO,
4659 but select says there is input. */
4661 if (read_kbd && interrupt_input
4662 && keyboard_bit_set (&Available) && ! noninteractive)
4663 handle_input_available_signal (SIGIO);
4664 #endif
4666 if (! wait_proc)
4667 got_some_input |= nfds > 0;
4669 /* If checking input just got us a size-change event from X,
4670 obey it now if we should. */
4671 if (read_kbd || ! NILP (wait_for_cell))
4672 do_pending_window_change (0);
4674 /* Check for data from a process. */
4675 if (no_avail || nfds == 0)
4676 continue;
4678 for (channel = 0; channel <= max_input_desc; ++channel)
4680 struct fd_callback_data *d = &fd_callback_info[channel];
4681 if (d->func
4682 && ((d->condition & FOR_READ
4683 && FD_ISSET (channel, &Available))
4684 || (d->condition & FOR_WRITE
4685 && FD_ISSET (channel, &write_mask))))
4686 d->func (channel, d->data);
4689 for (channel = 0; channel <= max_process_desc; channel++)
4691 if (FD_ISSET (channel, &Available)
4692 && FD_ISSET (channel, &non_keyboard_wait_mask)
4693 && !FD_ISSET (channel, &non_process_wait_mask))
4695 int nread;
4697 /* If waiting for this channel, arrange to return as
4698 soon as no more input to be processed. No more
4699 waiting. */
4700 if (wait_channel == channel)
4702 wait_channel = -1;
4703 nsecs = -1;
4704 got_some_input = 1;
4706 proc = chan_process[channel];
4707 if (NILP (proc))
4708 continue;
4710 /* If this is a server stream socket, accept connection. */
4711 if (EQ (XPROCESS (proc)->status, Qlisten))
4713 server_accept_connection (proc, channel);
4714 continue;
4717 /* Read data from the process, starting with our
4718 buffered-ahead character if we have one. */
4720 nread = read_process_output (proc, channel);
4721 if (nread > 0)
4723 /* Since read_process_output can run a filter,
4724 which can call accept-process-output,
4725 don't try to read from any other processes
4726 before doing the select again. */
4727 FD_ZERO (&Available);
4729 if (do_display)
4730 redisplay_preserve_echo_area (12);
4732 #ifdef EWOULDBLOCK
4733 else if (nread == -1 && errno == EWOULDBLOCK)
4735 #endif
4736 else if (nread == -1 && errno == EAGAIN)
4738 #ifdef WINDOWSNT
4739 /* FIXME: Is this special case still needed? */
4740 /* Note that we cannot distinguish between no input
4741 available now and a closed pipe.
4742 With luck, a closed pipe will be accompanied by
4743 subprocess termination and SIGCHLD. */
4744 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
4746 #endif
4747 #ifdef HAVE_PTYS
4748 /* On some OSs with ptys, when the process on one end of
4749 a pty exits, the other end gets an error reading with
4750 errno = EIO instead of getting an EOF (0 bytes read).
4751 Therefore, if we get an error reading and errno =
4752 EIO, just continue, because the child process has
4753 exited and should clean itself up soon (e.g. when we
4754 get a SIGCHLD). */
4755 else if (nread == -1 && errno == EIO)
4757 struct Lisp_Process *p = XPROCESS (proc);
4759 /* Clear the descriptor now, so we only raise the
4760 signal once. */
4761 FD_CLR (channel, &input_wait_mask);
4762 FD_CLR (channel, &non_keyboard_wait_mask);
4764 if (p->pid == -2)
4766 /* If the EIO occurs on a pty, the SIGCHLD handler's
4767 waitpid call will not find the process object to
4768 delete. Do it here. */
4769 p->tick = ++process_tick;
4770 pset_status (p, Qfailed);
4773 #endif /* HAVE_PTYS */
4774 /* If we can detect process termination, don't consider the
4775 process gone just because its pipe is closed. */
4776 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
4778 else
4780 /* Preserve status of processes already terminated. */
4781 XPROCESS (proc)->tick = ++process_tick;
4782 deactivate_process (proc);
4783 if (XPROCESS (proc)->raw_status_new)
4784 update_status (XPROCESS (proc));
4785 if (EQ (XPROCESS (proc)->status, Qrun))
4786 pset_status (XPROCESS (proc),
4787 list2 (Qexit, make_number (256)));
4790 #ifdef NON_BLOCKING_CONNECT
4791 if (FD_ISSET (channel, &Writeok)
4792 && FD_ISSET (channel, &connect_wait_mask))
4794 struct Lisp_Process *p;
4796 FD_CLR (channel, &connect_wait_mask);
4797 FD_CLR (channel, &write_mask);
4798 if (--num_pending_connects < 0)
4799 emacs_abort ();
4801 proc = chan_process[channel];
4802 if (NILP (proc))
4803 continue;
4805 p = XPROCESS (proc);
4807 #ifdef GNU_LINUX
4808 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4809 So only use it on systems where it is known to work. */
4811 socklen_t xlen = sizeof (xerrno);
4812 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
4813 xerrno = errno;
4815 #else
4817 struct sockaddr pname;
4818 int pnamelen = sizeof (pname);
4820 /* If connection failed, getpeername will fail. */
4821 xerrno = 0;
4822 if (getpeername (channel, &pname, &pnamelen) < 0)
4824 /* Obtain connect failure code through error slippage. */
4825 char dummy;
4826 xerrno = errno;
4827 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
4828 xerrno = errno;
4831 #endif
4832 if (xerrno)
4834 p->tick = ++process_tick;
4835 pset_status (p, list2 (Qfailed, make_number (xerrno)));
4836 deactivate_process (proc);
4838 else
4840 pset_status (p, Qrun);
4841 /* Execute the sentinel here. If we had relied on
4842 status_notify to do it later, it will read input
4843 from the process before calling the sentinel. */
4844 exec_sentinel (proc, build_string ("open\n"));
4845 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
4847 FD_SET (p->infd, &input_wait_mask);
4848 FD_SET (p->infd, &non_keyboard_wait_mask);
4852 #endif /* NON_BLOCKING_CONNECT */
4853 } /* End for each file descriptor. */
4854 } /* End while exit conditions not met. */
4856 unbind_to (count, Qnil);
4858 /* If calling from keyboard input, do not quit
4859 since we want to return C-g as an input character.
4860 Otherwise, do pending quit if requested. */
4861 if (read_kbd >= 0)
4863 /* Prevent input_pending from remaining set if we quit. */
4864 clear_input_pending ();
4865 QUIT;
4868 return got_some_input;
4871 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4873 static Lisp_Object
4874 read_process_output_call (Lisp_Object fun_and_args)
4876 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
4879 static Lisp_Object
4880 read_process_output_error_handler (Lisp_Object error_val)
4882 cmd_error_internal (error_val, "error in process filter: ");
4883 Vinhibit_quit = Qt;
4884 update_echo_area ();
4885 Fsleep_for (make_number (2), Qnil);
4886 return Qt;
4889 static void
4890 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
4891 ssize_t nbytes,
4892 struct coding_system *coding);
4894 /* Read pending output from the process channel,
4895 starting with our buffered-ahead character if we have one.
4896 Yield number of decoded characters read.
4898 This function reads at most 4096 characters.
4899 If you want to read all available subprocess output,
4900 you must call it repeatedly until it returns zero.
4902 The characters read are decoded according to PROC's coding-system
4903 for decoding. */
4905 static int
4906 read_process_output (Lisp_Object proc, register int channel)
4908 register ssize_t nbytes;
4909 char *chars;
4910 register struct Lisp_Process *p = XPROCESS (proc);
4911 struct coding_system *coding = proc_decode_coding_system[channel];
4912 int carryover = p->decoding_carryover;
4913 int readmax = 4096;
4914 ptrdiff_t count = SPECPDL_INDEX ();
4915 Lisp_Object odeactivate;
4917 chars = alloca (carryover + readmax);
4918 if (carryover)
4919 /* See the comment above. */
4920 memcpy (chars, SDATA (p->decoding_buf), carryover);
4922 #ifdef DATAGRAM_SOCKETS
4923 /* We have a working select, so proc_buffered_char is always -1. */
4924 if (DATAGRAM_CHAN_P (channel))
4926 socklen_t len = datagram_address[channel].len;
4927 nbytes = recvfrom (channel, chars + carryover, readmax,
4928 0, datagram_address[channel].sa, &len);
4930 else
4931 #endif
4933 bool buffered = proc_buffered_char[channel] >= 0;
4934 if (buffered)
4936 chars[carryover] = proc_buffered_char[channel];
4937 proc_buffered_char[channel] = -1;
4939 #ifdef HAVE_GNUTLS
4940 if (p->gnutls_p)
4941 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
4942 readmax - buffered);
4943 else
4944 #endif
4945 nbytes = emacs_read (channel, chars + carryover + buffered,
4946 readmax - buffered);
4947 #ifdef ADAPTIVE_READ_BUFFERING
4948 if (nbytes > 0 && p->adaptive_read_buffering)
4950 int delay = p->read_output_delay;
4951 if (nbytes < 256)
4953 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
4955 if (delay == 0)
4956 process_output_delay_count++;
4957 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
4960 else if (delay > 0 && nbytes == readmax - buffered)
4962 delay -= READ_OUTPUT_DELAY_INCREMENT;
4963 if (delay == 0)
4964 process_output_delay_count--;
4966 p->read_output_delay = delay;
4967 if (delay)
4969 p->read_output_skip = 1;
4970 process_output_skip = 1;
4973 #endif
4974 nbytes += buffered;
4975 nbytes += buffered && nbytes <= 0;
4978 p->decoding_carryover = 0;
4980 /* At this point, NBYTES holds number of bytes just received
4981 (including the one in proc_buffered_char[channel]). */
4982 if (nbytes <= 0)
4984 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
4985 return nbytes;
4986 coding->mode |= CODING_MODE_LAST_BLOCK;
4989 /* Now set NBYTES how many bytes we must decode. */
4990 nbytes += carryover;
4992 odeactivate = Vdeactivate_mark;
4993 /* There's no good reason to let process filters change the current
4994 buffer, and many callers of accept-process-output, sit-for, and
4995 friends don't expect current-buffer to be changed from under them. */
4996 record_unwind_current_buffer ();
4998 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5000 /* Handling the process output should not deactivate the mark. */
5001 Vdeactivate_mark = odeactivate;
5003 unbind_to (count, Qnil);
5004 return nbytes;
5007 static void
5008 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5009 ssize_t nbytes,
5010 struct coding_system *coding)
5012 Lisp_Object outstream = p->filter;
5013 Lisp_Object text;
5014 bool outer_running_asynch_code = running_asynch_code;
5015 int waiting = waiting_for_user_input_p;
5017 /* No need to gcpro these, because all we do with them later
5018 is test them for EQness, and none of them should be a string. */
5019 #if 0
5020 Lisp_Object obuffer, okeymap;
5021 XSETBUFFER (obuffer, current_buffer);
5022 okeymap = BVAR (current_buffer, keymap);
5023 #endif
5025 /* We inhibit quit here instead of just catching it so that
5026 hitting ^G when a filter happens to be running won't screw
5027 it up. */
5028 specbind (Qinhibit_quit, Qt);
5029 specbind (Qlast_nonmenu_event, Qt);
5031 /* In case we get recursively called,
5032 and we already saved the match data nonrecursively,
5033 save the same match data in safely recursive fashion. */
5034 if (outer_running_asynch_code)
5036 Lisp_Object tem;
5037 /* Don't clobber the CURRENT match data, either! */
5038 tem = Fmatch_data (Qnil, Qnil, Qnil);
5039 restore_search_regs ();
5040 record_unwind_save_match_data ();
5041 Fset_match_data (tem, Qt);
5044 /* For speed, if a search happens within this code,
5045 save the match data in a special nonrecursive fashion. */
5046 running_asynch_code = 1;
5048 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5049 text = coding->dst_object;
5050 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5051 /* A new coding system might be found. */
5052 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5054 pset_decode_coding_system (p, Vlast_coding_system_used);
5056 /* Don't call setup_coding_system for
5057 proc_decode_coding_system[channel] here. It is done in
5058 detect_coding called via decode_coding above. */
5060 /* If a coding system for encoding is not yet decided, we set
5061 it as the same as coding-system for decoding.
5063 But, before doing that we must check if
5064 proc_encode_coding_system[p->outfd] surely points to a
5065 valid memory because p->outfd will be changed once EOF is
5066 sent to the process. */
5067 if (NILP (p->encode_coding_system)
5068 && proc_encode_coding_system[p->outfd])
5070 pset_encode_coding_system
5071 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5072 setup_coding_system (p->encode_coding_system,
5073 proc_encode_coding_system[p->outfd]);
5077 if (coding->carryover_bytes > 0)
5079 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5080 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5081 memcpy (SDATA (p->decoding_buf), coding->carryover,
5082 coding->carryover_bytes);
5083 p->decoding_carryover = coding->carryover_bytes;
5085 if (SBYTES (text) > 0)
5086 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5087 sometimes it's simply wrong to wrap (e.g. when called from
5088 accept-process-output). */
5089 internal_condition_case_1 (read_process_output_call,
5090 list3 (outstream, make_lisp_proc (p), text),
5091 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5092 read_process_output_error_handler);
5094 /* If we saved the match data nonrecursively, restore it now. */
5095 restore_search_regs ();
5096 running_asynch_code = outer_running_asynch_code;
5098 /* Restore waiting_for_user_input_p as it was
5099 when we were called, in case the filter clobbered it. */
5100 waiting_for_user_input_p = waiting;
5102 #if 0 /* Call record_asynch_buffer_change unconditionally,
5103 because we might have changed minor modes or other things
5104 that affect key bindings. */
5105 if (! EQ (Fcurrent_buffer (), obuffer)
5106 || ! EQ (current_buffer->keymap, okeymap))
5107 #endif
5108 /* But do it only if the caller is actually going to read events.
5109 Otherwise there's no need to make him wake up, and it could
5110 cause trouble (for example it would make sit_for return). */
5111 if (waiting_for_user_input_p == -1)
5112 record_asynch_buffer_change ();
5115 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
5116 Sinternal_default_process_filter, 2, 2, 0,
5117 doc: /* Function used as default process filter. */)
5118 (Lisp_Object proc, Lisp_Object text)
5120 struct Lisp_Process *p;
5121 ptrdiff_t opoint;
5123 CHECK_PROCESS (proc);
5124 p = XPROCESS (proc);
5125 CHECK_STRING (text);
5127 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
5129 Lisp_Object old_read_only;
5130 ptrdiff_t old_begv, old_zv;
5131 ptrdiff_t old_begv_byte, old_zv_byte;
5132 ptrdiff_t before, before_byte;
5133 ptrdiff_t opoint_byte;
5134 struct buffer *b;
5136 Fset_buffer (p->buffer);
5137 opoint = PT;
5138 opoint_byte = PT_BYTE;
5139 old_read_only = BVAR (current_buffer, read_only);
5140 old_begv = BEGV;
5141 old_zv = ZV;
5142 old_begv_byte = BEGV_BYTE;
5143 old_zv_byte = ZV_BYTE;
5145 bset_read_only (current_buffer, Qnil);
5147 /* Insert new output into buffer
5148 at the current end-of-output marker,
5149 thus preserving logical ordering of input and output. */
5150 if (XMARKER (p->mark)->buffer)
5151 SET_PT_BOTH (clip_to_bounds (BEGV,
5152 marker_position (p->mark), ZV),
5153 clip_to_bounds (BEGV_BYTE,
5154 marker_byte_position (p->mark),
5155 ZV_BYTE));
5156 else
5157 SET_PT_BOTH (ZV, ZV_BYTE);
5158 before = PT;
5159 before_byte = PT_BYTE;
5161 /* If the output marker is outside of the visible region, save
5162 the restriction and widen. */
5163 if (! (BEGV <= PT && PT <= ZV))
5164 Fwiden ();
5166 /* Adjust the multibyteness of TEXT to that of the buffer. */
5167 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
5168 != ! STRING_MULTIBYTE (text))
5169 text = (STRING_MULTIBYTE (text)
5170 ? Fstring_as_unibyte (text)
5171 : Fstring_to_multibyte (text));
5172 /* Insert before markers in case we are inserting where
5173 the buffer's mark is, and the user's next command is Meta-y. */
5174 insert_from_string_before_markers (text, 0, 0,
5175 SCHARS (text), SBYTES (text), 0);
5177 /* Make sure the process marker's position is valid when the
5178 process buffer is changed in the signal_after_change above.
5179 W3 is known to do that. */
5180 if (BUFFERP (p->buffer)
5181 && (b = XBUFFER (p->buffer), b != current_buffer))
5182 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
5183 else
5184 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
5186 update_mode_lines++;
5188 /* Make sure opoint and the old restrictions
5189 float ahead of any new text just as point would. */
5190 if (opoint >= before)
5192 opoint += PT - before;
5193 opoint_byte += PT_BYTE - before_byte;
5195 if (old_begv > before)
5197 old_begv += PT - before;
5198 old_begv_byte += PT_BYTE - before_byte;
5200 if (old_zv >= before)
5202 old_zv += PT - before;
5203 old_zv_byte += PT_BYTE - before_byte;
5206 /* If the restriction isn't what it should be, set it. */
5207 if (old_begv != BEGV || old_zv != ZV)
5208 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
5210 bset_read_only (current_buffer, old_read_only);
5211 SET_PT_BOTH (opoint, opoint_byte);
5213 return Qnil;
5216 /* Sending data to subprocess. */
5218 /* In send_process, when a write fails temporarily,
5219 wait_reading_process_output is called. It may execute user code,
5220 e.g. timers, that attempts to write new data to the same process.
5221 We must ensure that data is sent in the right order, and not
5222 interspersed half-completed with other writes (Bug#10815). This is
5223 handled by the write_queue element of struct process. It is a list
5224 with each entry having the form
5226 (string . (offset . length))
5228 where STRING is a lisp string, OFFSET is the offset into the
5229 string's byte sequence from which we should begin to send, and
5230 LENGTH is the number of bytes left to send. */
5232 /* Create a new entry in write_queue.
5233 INPUT_OBJ should be a buffer, string Qt, or Qnil.
5234 BUF is a pointer to the string sequence of the input_obj or a C
5235 string in case of Qt or Qnil. */
5237 static void
5238 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
5239 const char *buf, ptrdiff_t len, bool front)
5241 ptrdiff_t offset;
5242 Lisp_Object entry, obj;
5244 if (STRINGP (input_obj))
5246 offset = buf - SSDATA (input_obj);
5247 obj = input_obj;
5249 else
5251 offset = 0;
5252 obj = make_unibyte_string (buf, len);
5255 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
5257 if (front)
5258 pset_write_queue (p, Fcons (entry, p->write_queue));
5259 else
5260 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
5263 /* Remove the first element in the write_queue of process P, put its
5264 contents in OBJ, BUF and LEN, and return true. If the
5265 write_queue is empty, return false. */
5267 static bool
5268 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
5269 const char **buf, ptrdiff_t *len)
5271 Lisp_Object entry, offset_length;
5272 ptrdiff_t offset;
5274 if (NILP (p->write_queue))
5275 return 0;
5277 entry = XCAR (p->write_queue);
5278 pset_write_queue (p, XCDR (p->write_queue));
5280 *obj = XCAR (entry);
5281 offset_length = XCDR (entry);
5283 *len = XINT (XCDR (offset_length));
5284 offset = XINT (XCAR (offset_length));
5285 *buf = SSDATA (*obj) + offset;
5287 return 1;
5290 /* Send some data to process PROC.
5291 BUF is the beginning of the data; LEN is the number of characters.
5292 OBJECT is the Lisp object that the data comes from. If OBJECT is
5293 nil or t, it means that the data comes from C string.
5295 If OBJECT is not nil, the data is encoded by PROC's coding-system
5296 for encoding before it is sent.
5298 This function can evaluate Lisp code and can garbage collect. */
5300 static void
5301 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
5302 Lisp_Object object)
5304 struct Lisp_Process *p = XPROCESS (proc);
5305 ssize_t rv;
5306 struct coding_system *coding;
5308 if (p->raw_status_new)
5309 update_status (p);
5310 if (! EQ (p->status, Qrun))
5311 error ("Process %s not running", SDATA (p->name));
5312 if (p->outfd < 0)
5313 error ("Output file descriptor of %s is closed", SDATA (p->name));
5315 coding = proc_encode_coding_system[p->outfd];
5316 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5318 if ((STRINGP (object) && STRING_MULTIBYTE (object))
5319 || (BUFFERP (object)
5320 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
5321 || EQ (object, Qt))
5323 pset_encode_coding_system
5324 (p, complement_process_encoding_system (p->encode_coding_system));
5325 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
5327 /* The coding system for encoding was changed to raw-text
5328 because we sent a unibyte text previously. Now we are
5329 sending a multibyte text, thus we must encode it by the
5330 original coding system specified for the current process.
5332 Another reason we come here is that the coding system
5333 was just complemented and a new one was returned by
5334 complement_process_encoding_system. */
5335 setup_coding_system (p->encode_coding_system, coding);
5336 Vlast_coding_system_used = p->encode_coding_system;
5338 coding->src_multibyte = 1;
5340 else
5342 coding->src_multibyte = 0;
5343 /* For sending a unibyte text, character code conversion should
5344 not take place but EOL conversion should. So, setup raw-text
5345 or one of the subsidiary if we have not yet done it. */
5346 if (CODING_REQUIRE_ENCODING (coding))
5348 if (CODING_REQUIRE_FLUSHING (coding))
5350 /* But, before changing the coding, we must flush out data. */
5351 coding->mode |= CODING_MODE_LAST_BLOCK;
5352 send_process (proc, "", 0, Qt);
5353 coding->mode &= CODING_MODE_LAST_BLOCK;
5355 setup_coding_system (raw_text_coding_system
5356 (Vlast_coding_system_used),
5357 coding);
5358 coding->src_multibyte = 0;
5361 coding->dst_multibyte = 0;
5363 if (CODING_REQUIRE_ENCODING (coding))
5365 coding->dst_object = Qt;
5366 if (BUFFERP (object))
5368 ptrdiff_t from_byte, from, to;
5369 ptrdiff_t save_pt, save_pt_byte;
5370 struct buffer *cur = current_buffer;
5372 set_buffer_internal (XBUFFER (object));
5373 save_pt = PT, save_pt_byte = PT_BYTE;
5375 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
5376 from = BYTE_TO_CHAR (from_byte);
5377 to = BYTE_TO_CHAR (from_byte + len);
5378 TEMP_SET_PT_BOTH (from, from_byte);
5379 encode_coding_object (coding, object, from, from_byte,
5380 to, from_byte + len, Qt);
5381 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
5382 set_buffer_internal (cur);
5384 else if (STRINGP (object))
5386 encode_coding_object (coding, object, 0, 0, SCHARS (object),
5387 SBYTES (object), Qt);
5389 else
5391 coding->dst_object = make_unibyte_string (buf, len);
5392 coding->produced = len;
5395 len = coding->produced;
5396 object = coding->dst_object;
5397 buf = SSDATA (object);
5400 /* If there is already data in the write_queue, put the new data
5401 in the back of queue. Otherwise, ignore it. */
5402 if (!NILP (p->write_queue))
5403 write_queue_push (p, object, buf, len, 0);
5405 do /* while !NILP (p->write_queue) */
5407 ptrdiff_t cur_len = -1;
5408 const char *cur_buf;
5409 Lisp_Object cur_object;
5411 /* If write_queue is empty, ignore it. */
5412 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
5414 cur_len = len;
5415 cur_buf = buf;
5416 cur_object = object;
5419 while (cur_len > 0)
5421 /* Send this batch, using one or more write calls. */
5422 ptrdiff_t written = 0;
5423 int outfd = p->outfd;
5424 #ifdef DATAGRAM_SOCKETS
5425 if (DATAGRAM_CHAN_P (outfd))
5427 rv = sendto (outfd, cur_buf, cur_len,
5428 0, datagram_address[outfd].sa,
5429 datagram_address[outfd].len);
5430 if (rv >= 0)
5431 written = rv;
5432 else if (errno == EMSGSIZE)
5433 report_file_error ("Sending datagram", proc);
5435 else
5436 #endif
5438 #ifdef HAVE_GNUTLS
5439 if (p->gnutls_p)
5440 written = emacs_gnutls_write (p, cur_buf, cur_len);
5441 else
5442 #endif
5443 written = emacs_write_sig (outfd, cur_buf, cur_len);
5444 rv = (written ? 0 : -1);
5445 #ifdef ADAPTIVE_READ_BUFFERING
5446 if (p->read_output_delay > 0
5447 && p->adaptive_read_buffering == 1)
5449 p->read_output_delay = 0;
5450 process_output_delay_count--;
5451 p->read_output_skip = 0;
5453 #endif
5456 if (rv < 0)
5458 if (errno == EAGAIN
5459 #ifdef EWOULDBLOCK
5460 || errno == EWOULDBLOCK
5461 #endif
5463 /* Buffer is full. Wait, accepting input;
5464 that may allow the program
5465 to finish doing output and read more. */
5467 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5468 /* A gross hack to work around a bug in FreeBSD.
5469 In the following sequence, read(2) returns
5470 bogus data:
5472 write(2) 1022 bytes
5473 write(2) 954 bytes, get EAGAIN
5474 read(2) 1024 bytes in process_read_output
5475 read(2) 11 bytes in process_read_output
5477 That is, read(2) returns more bytes than have
5478 ever been written successfully. The 1033 bytes
5479 read are the 1022 bytes written successfully
5480 after processing (for example with CRs added if
5481 the terminal is set up that way which it is
5482 here). The same bytes will be seen again in a
5483 later read(2), without the CRs. */
5485 if (errno == EAGAIN)
5487 int flags = FWRITE;
5488 ioctl (p->outfd, TIOCFLUSH, &flags);
5490 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5492 /* Put what we should have written in wait_queue. */
5493 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
5494 wait_reading_process_output (0, 20 * 1000 * 1000,
5495 0, 0, Qnil, NULL, 0);
5496 /* Reread queue, to see what is left. */
5497 break;
5499 else if (errno == EPIPE)
5501 p->raw_status_new = 0;
5502 pset_status (p, list2 (Qexit, make_number (256)));
5503 p->tick = ++process_tick;
5504 deactivate_process (proc);
5505 error ("process %s no longer connected to pipe; closed it",
5506 SDATA (p->name));
5508 else
5509 /* This is a real error. */
5510 report_file_error ("Writing to process", proc);
5512 cur_buf += written;
5513 cur_len -= written;
5516 while (!NILP (p->write_queue));
5519 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
5520 3, 3, 0,
5521 doc: /* Send current contents of region as input to PROCESS.
5522 PROCESS may be a process, a buffer, the name of a process or buffer, or
5523 nil, indicating the current buffer's process.
5524 Called from program, takes three arguments, PROCESS, START and END.
5525 If the region is more than 500 characters long,
5526 it is sent in several bunches. This may happen even for shorter regions.
5527 Output from processes can arrive in between bunches. */)
5528 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
5530 Lisp_Object proc = get_process (process);
5531 ptrdiff_t start_byte, end_byte;
5533 validate_region (&start, &end);
5535 start_byte = CHAR_TO_BYTE (XINT (start));
5536 end_byte = CHAR_TO_BYTE (XINT (end));
5538 if (XINT (start) < GPT && XINT (end) > GPT)
5539 move_gap_both (XINT (start), start_byte);
5541 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
5542 end_byte - start_byte, Fcurrent_buffer ());
5544 return Qnil;
5547 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
5548 2, 2, 0,
5549 doc: /* Send PROCESS the contents of STRING as input.
5550 PROCESS may be a process, a buffer, the name of a process or buffer, or
5551 nil, indicating the current buffer's process.
5552 If STRING is more than 500 characters long,
5553 it is sent in several bunches. This may happen even for shorter strings.
5554 Output from processes can arrive in between bunches. */)
5555 (Lisp_Object process, Lisp_Object string)
5557 Lisp_Object proc;
5558 CHECK_STRING (string);
5559 proc = get_process (process);
5560 send_process (proc, SSDATA (string),
5561 SBYTES (string), string);
5562 return Qnil;
5565 /* Return the foreground process group for the tty/pty that
5566 the process P uses. */
5567 static pid_t
5568 emacs_get_tty_pgrp (struct Lisp_Process *p)
5570 pid_t gid = -1;
5572 #ifdef TIOCGPGRP
5573 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
5575 int fd;
5576 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5577 master side. Try the slave side. */
5578 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
5580 if (fd != -1)
5582 ioctl (fd, TIOCGPGRP, &gid);
5583 emacs_close (fd);
5586 #endif /* defined (TIOCGPGRP ) */
5588 return gid;
5591 DEFUN ("process-running-child-p", Fprocess_running_child_p,
5592 Sprocess_running_child_p, 0, 1, 0,
5593 doc: /* Return t if PROCESS has given the terminal to a child.
5594 If the operating system does not make it possible to find out,
5595 return t unconditionally. */)
5596 (Lisp_Object process)
5598 /* Initialize in case ioctl doesn't exist or gives an error,
5599 in a way that will cause returning t. */
5600 pid_t gid;
5601 Lisp_Object proc;
5602 struct Lisp_Process *p;
5604 proc = get_process (process);
5605 p = XPROCESS (proc);
5607 if (!EQ (p->type, Qreal))
5608 error ("Process %s is not a subprocess",
5609 SDATA (p->name));
5610 if (p->infd < 0)
5611 error ("Process %s is not active",
5612 SDATA (p->name));
5614 gid = emacs_get_tty_pgrp (p);
5616 if (gid == p->pid)
5617 return Qnil;
5618 return Qt;
5621 /* send a signal number SIGNO to PROCESS.
5622 If CURRENT_GROUP is t, that means send to the process group
5623 that currently owns the terminal being used to communicate with PROCESS.
5624 This is used for various commands in shell mode.
5625 If CURRENT_GROUP is lambda, that means send to the process group
5626 that currently owns the terminal, but only if it is NOT the shell itself.
5628 If NOMSG is false, insert signal-announcements into process's buffers
5629 right away.
5631 If we can, we try to signal PROCESS by sending control characters
5632 down the pty. This allows us to signal inferiors who have changed
5633 their uid, for which kill would return an EPERM error. */
5635 static void
5636 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
5637 bool nomsg)
5639 Lisp_Object proc;
5640 struct Lisp_Process *p;
5641 pid_t gid;
5642 bool no_pgrp = 0;
5644 proc = get_process (process);
5645 p = XPROCESS (proc);
5647 if (!EQ (p->type, Qreal))
5648 error ("Process %s is not a subprocess",
5649 SDATA (p->name));
5650 if (p->infd < 0)
5651 error ("Process %s is not active",
5652 SDATA (p->name));
5654 if (!p->pty_flag)
5655 current_group = Qnil;
5657 /* If we are using pgrps, get a pgrp number and make it negative. */
5658 if (NILP (current_group))
5659 /* Send the signal to the shell's process group. */
5660 gid = p->pid;
5661 else
5663 #ifdef SIGNALS_VIA_CHARACTERS
5664 /* If possible, send signals to the entire pgrp
5665 by sending an input character to it. */
5667 struct termios t;
5668 cc_t *sig_char = NULL;
5670 tcgetattr (p->infd, &t);
5672 switch (signo)
5674 case SIGINT:
5675 sig_char = &t.c_cc[VINTR];
5676 break;
5678 case SIGQUIT:
5679 sig_char = &t.c_cc[VQUIT];
5680 break;
5682 case SIGTSTP:
5683 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5684 sig_char = &t.c_cc[VSWTCH];
5685 #else
5686 sig_char = &t.c_cc[VSUSP];
5687 #endif
5688 break;
5691 if (sig_char && *sig_char != CDISABLE)
5693 send_process (proc, (char *) sig_char, 1, Qnil);
5694 return;
5696 /* If we can't send the signal with a character,
5697 fall through and send it another way. */
5699 /* The code above may fall through if it can't
5700 handle the signal. */
5701 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5703 #ifdef TIOCGPGRP
5704 /* Get the current pgrp using the tty itself, if we have that.
5705 Otherwise, use the pty to get the pgrp.
5706 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5707 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5708 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5709 His patch indicates that if TIOCGPGRP returns an error, then
5710 we should just assume that p->pid is also the process group id. */
5712 gid = emacs_get_tty_pgrp (p);
5714 if (gid == -1)
5715 /* If we can't get the information, assume
5716 the shell owns the tty. */
5717 gid = p->pid;
5719 /* It is not clear whether anything really can set GID to -1.
5720 Perhaps on some system one of those ioctls can or could do so.
5721 Or perhaps this is vestigial. */
5722 if (gid == -1)
5723 no_pgrp = 1;
5724 #else /* ! defined (TIOCGPGRP ) */
5725 /* Can't select pgrps on this system, so we know that
5726 the child itself heads the pgrp. */
5727 gid = p->pid;
5728 #endif /* ! defined (TIOCGPGRP ) */
5730 /* If current_group is lambda, and the shell owns the terminal,
5731 don't send any signal. */
5732 if (EQ (current_group, Qlambda) && gid == p->pid)
5733 return;
5736 switch (signo)
5738 #ifdef SIGCONT
5739 case SIGCONT:
5740 p->raw_status_new = 0;
5741 pset_status (p, Qrun);
5742 p->tick = ++process_tick;
5743 if (!nomsg)
5745 status_notify (NULL);
5746 redisplay_preserve_echo_area (13);
5748 break;
5749 #endif /* ! defined (SIGCONT) */
5750 case SIGINT:
5751 case SIGQUIT:
5752 case SIGKILL:
5753 flush_pending_output (p->infd);
5754 break;
5757 /* If we don't have process groups, send the signal to the immediate
5758 subprocess. That isn't really right, but it's better than any
5759 obvious alternative. */
5760 if (no_pgrp)
5762 kill (p->pid, signo);
5763 return;
5766 /* gid may be a pid, or minus a pgrp's number */
5767 #ifdef TIOCSIGSEND
5768 if (!NILP (current_group))
5770 if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
5771 kill (-gid, signo);
5773 else
5775 gid = - p->pid;
5776 kill (gid, signo);
5778 #else /* ! defined (TIOCSIGSEND) */
5779 kill (-gid, signo);
5780 #endif /* ! defined (TIOCSIGSEND) */
5783 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
5784 doc: /* Interrupt process PROCESS.
5785 PROCESS may be a process, a buffer, or the name of a process or buffer.
5786 No arg or nil means current buffer's process.
5787 Second arg CURRENT-GROUP non-nil means send signal to
5788 the current process-group of the process's controlling terminal
5789 rather than to the process's own process group.
5790 If the process is a shell, this means interrupt current subjob
5791 rather than the shell.
5793 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5794 don't send the signal. */)
5795 (Lisp_Object process, Lisp_Object current_group)
5797 process_send_signal (process, SIGINT, current_group, 0);
5798 return process;
5801 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
5802 doc: /* Kill process PROCESS. May be process or name of one.
5803 See function `interrupt-process' for more details on usage. */)
5804 (Lisp_Object process, Lisp_Object current_group)
5806 process_send_signal (process, SIGKILL, current_group, 0);
5807 return process;
5810 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
5811 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
5812 See function `interrupt-process' for more details on usage. */)
5813 (Lisp_Object process, Lisp_Object current_group)
5815 process_send_signal (process, SIGQUIT, current_group, 0);
5816 return process;
5819 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
5820 doc: /* Stop process PROCESS. May be process or name of one.
5821 See function `interrupt-process' for more details on usage.
5822 If PROCESS is a network or serial process, inhibit handling of incoming
5823 traffic. */)
5824 (Lisp_Object process, Lisp_Object current_group)
5826 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
5828 struct Lisp_Process *p;
5830 p = XPROCESS (process);
5831 if (NILP (p->command)
5832 && p->infd >= 0)
5834 FD_CLR (p->infd, &input_wait_mask);
5835 FD_CLR (p->infd, &non_keyboard_wait_mask);
5837 pset_command (p, Qt);
5838 return process;
5840 #ifndef SIGTSTP
5841 error ("No SIGTSTP support");
5842 #else
5843 process_send_signal (process, SIGTSTP, current_group, 0);
5844 #endif
5845 return process;
5848 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
5849 doc: /* Continue process PROCESS. May be process or name of one.
5850 See function `interrupt-process' for more details on usage.
5851 If PROCESS is a network or serial process, resume handling of incoming
5852 traffic. */)
5853 (Lisp_Object process, Lisp_Object current_group)
5855 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
5857 struct Lisp_Process *p;
5859 p = XPROCESS (process);
5860 if (EQ (p->command, Qt)
5861 && p->infd >= 0
5862 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5864 FD_SET (p->infd, &input_wait_mask);
5865 FD_SET (p->infd, &non_keyboard_wait_mask);
5866 #ifdef WINDOWSNT
5867 if (fd_info[ p->infd ].flags & FILE_SERIAL)
5868 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
5869 #else /* not WINDOWSNT */
5870 tcflush (p->infd, TCIFLUSH);
5871 #endif /* not WINDOWSNT */
5873 pset_command (p, Qnil);
5874 return process;
5876 #ifdef SIGCONT
5877 process_send_signal (process, SIGCONT, current_group, 0);
5878 #else
5879 error ("No SIGCONT support");
5880 #endif
5881 return process;
5884 /* Return the integer value of the signal whose abbreviation is ABBR,
5885 or a negative number if there is no such signal. */
5886 static int
5887 abbr_to_signal (char const *name)
5889 int i, signo;
5890 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
5892 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
5893 name += 3;
5895 for (i = 0; i < sizeof sigbuf; i++)
5897 sigbuf[i] = c_toupper (name[i]);
5898 if (! sigbuf[i])
5899 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
5902 return -1;
5905 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
5906 2, 2, "sProcess (name or number): \nnSignal code: ",
5907 doc: /* Send PROCESS the signal with code SIGCODE.
5908 PROCESS may also be a number specifying the process id of the
5909 process to signal; in this case, the process need not be a child of
5910 this Emacs.
5911 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5912 (Lisp_Object process, Lisp_Object sigcode)
5914 pid_t pid;
5915 int signo;
5917 if (STRINGP (process))
5919 Lisp_Object tem = Fget_process (process);
5920 if (NILP (tem))
5922 Lisp_Object process_number =
5923 string_to_number (SSDATA (process), 10, 1);
5924 if (INTEGERP (process_number) || FLOATP (process_number))
5925 tem = process_number;
5927 process = tem;
5929 else if (!NUMBERP (process))
5930 process = get_process (process);
5932 if (NILP (process))
5933 return process;
5935 if (NUMBERP (process))
5936 CONS_TO_INTEGER (process, pid_t, pid);
5937 else
5939 CHECK_PROCESS (process);
5940 pid = XPROCESS (process)->pid;
5941 if (pid <= 0)
5942 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
5945 if (INTEGERP (sigcode))
5947 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
5948 signo = XINT (sigcode);
5950 else
5952 char *name;
5954 CHECK_SYMBOL (sigcode);
5955 name = SSDATA (SYMBOL_NAME (sigcode));
5957 signo = abbr_to_signal (name);
5958 if (signo < 0)
5959 error ("Undefined signal name %s", name);
5962 return make_number (kill (pid, signo));
5965 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
5966 doc: /* Make PROCESS see end-of-file in its input.
5967 EOF comes after any text already sent to it.
5968 PROCESS may be a process, a buffer, the name of a process or buffer, or
5969 nil, indicating the current buffer's process.
5970 If PROCESS is a network connection, or is a process communicating
5971 through a pipe (as opposed to a pty), then you cannot send any more
5972 text to PROCESS after you call this function.
5973 If PROCESS is a serial process, wait until all output written to the
5974 process has been transmitted to the serial port. */)
5975 (Lisp_Object process)
5977 Lisp_Object proc;
5978 struct coding_system *coding;
5980 if (DATAGRAM_CONN_P (process))
5981 return process;
5983 proc = get_process (process);
5984 coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
5986 /* Make sure the process is really alive. */
5987 if (XPROCESS (proc)->raw_status_new)
5988 update_status (XPROCESS (proc));
5989 if (! EQ (XPROCESS (proc)->status, Qrun))
5990 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
5992 if (CODING_REQUIRE_FLUSHING (coding))
5994 coding->mode |= CODING_MODE_LAST_BLOCK;
5995 send_process (proc, "", 0, Qnil);
5998 if (XPROCESS (proc)->pty_flag)
5999 send_process (proc, "\004", 1, Qnil);
6000 else if (EQ (XPROCESS (proc)->type, Qserial))
6002 #ifndef WINDOWSNT
6003 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6004 report_file_error ("Failed tcdrain", Qnil);
6005 #endif /* not WINDOWSNT */
6006 /* Do nothing on Windows because writes are blocking. */
6008 else
6010 int old_outfd, new_outfd;
6012 #ifdef HAVE_SHUTDOWN
6013 /* If this is a network connection, or socketpair is used
6014 for communication with the subprocess, call shutdown to cause EOF.
6015 (In some old system, shutdown to socketpair doesn't work.
6016 Then we just can't win.) */
6017 if (EQ (XPROCESS (proc)->type, Qnetwork)
6018 || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
6019 shutdown (XPROCESS (proc)->outfd, 1);
6020 /* In case of socketpair, outfd == infd, so don't close it. */
6021 if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
6022 emacs_close (XPROCESS (proc)->outfd);
6023 #else /* not HAVE_SHUTDOWN */
6024 emacs_close (XPROCESS (proc)->outfd);
6025 #endif /* not HAVE_SHUTDOWN */
6026 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6027 if (new_outfd < 0)
6028 emacs_abort ();
6029 old_outfd = XPROCESS (proc)->outfd;
6031 if (!proc_encode_coding_system[new_outfd])
6032 proc_encode_coding_system[new_outfd]
6033 = xmalloc (sizeof (struct coding_system));
6034 *proc_encode_coding_system[new_outfd]
6035 = *proc_encode_coding_system[old_outfd];
6036 memset (proc_encode_coding_system[old_outfd], 0,
6037 sizeof (struct coding_system));
6039 XPROCESS (proc)->outfd = new_outfd;
6041 return process;
6044 /* The main Emacs thread records child processes in three places:
6046 - Vprocess_alist, for asynchronous subprocesses, which are child
6047 processes visible to Lisp.
6049 - deleted_pid_list, for child processes invisible to Lisp,
6050 typically because of delete-process. These are recorded so that
6051 the processes can be reaped when they exit, so that the operating
6052 system's process table is not cluttered by zombies.
6054 - the local variable PID in Fcall_process, call_process_cleanup and
6055 call_process_kill, for synchronous subprocesses.
6056 record_unwind_protect is used to make sure this process is not
6057 forgotten: if the user interrupts call-process and the child
6058 process refuses to exit immediately even with two C-g's,
6059 call_process_kill adds PID's contents to deleted_pid_list before
6060 returning.
6062 The main Emacs thread invokes waitpid only on child processes that
6063 it creates and that have not been reaped. This avoid races on
6064 platforms such as GTK, where other threads create their own
6065 subprocesses which the main thread should not reap. For example,
6066 if the main thread attempted to reap an already-reaped child, it
6067 might inadvertently reap a GTK-created process that happened to
6068 have the same process ID. */
6070 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6071 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6072 keep track of its own children. GNUstep is similar. */
6074 static void dummy_handler (int sig) {}
6075 static signal_handler_t volatile lib_child_handler;
6077 /* Handle a SIGCHLD signal by looking for known child processes of
6078 Emacs whose status have changed. For each one found, record its
6079 new status.
6081 All we do is change the status; we do not run sentinels or print
6082 notifications. That is saved for the next time keyboard input is
6083 done, in order to avoid timing errors.
6085 ** WARNING: this can be called during garbage collection.
6086 Therefore, it must not be fooled by the presence of mark bits in
6087 Lisp objects.
6089 ** USG WARNING: Although it is not obvious from the documentation
6090 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6091 signal() before executing at least one wait(), otherwise the
6092 handler will be called again, resulting in an infinite loop. The
6093 relevant portion of the documentation reads "SIGCLD signals will be
6094 queued and the signal-catching function will be continually
6095 reentered until the queue is empty". Invoking signal() causes the
6096 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6097 Inc.
6099 ** Malloc WARNING: This should never call malloc either directly or
6100 indirectly; if it does, that is a bug */
6102 static void
6103 handle_child_signal (int sig)
6105 Lisp_Object tail;
6107 /* Find the process that signaled us, and record its status. */
6109 /* The process can have been deleted by Fdelete_process, or have
6110 been started asynchronously by Fcall_process. */
6111 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
6113 bool all_pids_are_fixnums
6114 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
6115 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
6116 Lisp_Object xpid = XCAR (tail);
6117 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
6119 pid_t deleted_pid;
6120 if (INTEGERP (xpid))
6121 deleted_pid = XINT (xpid);
6122 else
6123 deleted_pid = XFLOAT_DATA (xpid);
6124 if (child_status_changed (deleted_pid, 0, 0))
6125 XSETCAR (tail, Qnil);
6129 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6130 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6132 Lisp_Object proc = XCDR (XCAR (tail));
6133 struct Lisp_Process *p = XPROCESS (proc);
6134 int status;
6136 if (p->alive
6137 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
6139 /* Change the status of the process that was found. */
6140 p->tick = ++process_tick;
6141 p->raw_status = status;
6142 p->raw_status_new = 1;
6144 /* If process has terminated, stop waiting for its output. */
6145 if (WIFSIGNALED (status) || WIFEXITED (status))
6147 bool clear_desc_flag = 0;
6148 p->alive = 0;
6149 if (p->infd >= 0)
6150 clear_desc_flag = 1;
6152 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
6153 if (clear_desc_flag)
6155 FD_CLR (p->infd, &input_wait_mask);
6156 FD_CLR (p->infd, &non_keyboard_wait_mask);
6162 lib_child_handler (sig);
6163 #ifdef NS_IMPL_GNUSTEP
6164 /* NSTask in GNUStep sets its child handler each time it is called.
6165 So we must re-set ours. */
6166 catch_child_signal();
6167 #endif
6170 static void
6171 deliver_child_signal (int sig)
6173 deliver_process_signal (sig, handle_child_signal);
6177 static Lisp_Object
6178 exec_sentinel_error_handler (Lisp_Object error_val)
6180 cmd_error_internal (error_val, "error in process sentinel: ");
6181 Vinhibit_quit = Qt;
6182 update_echo_area ();
6183 Fsleep_for (make_number (2), Qnil);
6184 return Qt;
6187 static void
6188 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
6190 Lisp_Object sentinel, odeactivate;
6191 struct Lisp_Process *p = XPROCESS (proc);
6192 ptrdiff_t count = SPECPDL_INDEX ();
6193 bool outer_running_asynch_code = running_asynch_code;
6194 int waiting = waiting_for_user_input_p;
6196 if (inhibit_sentinels)
6197 return;
6199 /* No need to gcpro these, because all we do with them later
6200 is test them for EQness, and none of them should be a string. */
6201 odeactivate = Vdeactivate_mark;
6202 #if 0
6203 Lisp_Object obuffer, okeymap;
6204 XSETBUFFER (obuffer, current_buffer);
6205 okeymap = BVAR (current_buffer, keymap);
6206 #endif
6208 /* There's no good reason to let sentinels change the current
6209 buffer, and many callers of accept-process-output, sit-for, and
6210 friends don't expect current-buffer to be changed from under them. */
6211 record_unwind_current_buffer ();
6213 sentinel = p->sentinel;
6215 /* Inhibit quit so that random quits don't screw up a running filter. */
6216 specbind (Qinhibit_quit, Qt);
6217 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
6219 /* In case we get recursively called,
6220 and we already saved the match data nonrecursively,
6221 save the same match data in safely recursive fashion. */
6222 if (outer_running_asynch_code)
6224 Lisp_Object tem;
6225 tem = Fmatch_data (Qnil, Qnil, Qnil);
6226 restore_search_regs ();
6227 record_unwind_save_match_data ();
6228 Fset_match_data (tem, Qt);
6231 /* For speed, if a search happens within this code,
6232 save the match data in a special nonrecursive fashion. */
6233 running_asynch_code = 1;
6235 internal_condition_case_1 (read_process_output_call,
6236 list3 (sentinel, proc, reason),
6237 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6238 exec_sentinel_error_handler);
6240 /* If we saved the match data nonrecursively, restore it now. */
6241 restore_search_regs ();
6242 running_asynch_code = outer_running_asynch_code;
6244 Vdeactivate_mark = odeactivate;
6246 /* Restore waiting_for_user_input_p as it was
6247 when we were called, in case the filter clobbered it. */
6248 waiting_for_user_input_p = waiting;
6250 #if 0
6251 if (! EQ (Fcurrent_buffer (), obuffer)
6252 || ! EQ (current_buffer->keymap, okeymap))
6253 #endif
6254 /* But do it only if the caller is actually going to read events.
6255 Otherwise there's no need to make him wake up, and it could
6256 cause trouble (for example it would make sit_for return). */
6257 if (waiting_for_user_input_p == -1)
6258 record_asynch_buffer_change ();
6260 unbind_to (count, Qnil);
6263 /* Report all recent events of a change in process status
6264 (either run the sentinel or output a message).
6265 This is usually done while Emacs is waiting for keyboard input
6266 but can be done at other times. */
6268 static void
6269 status_notify (struct Lisp_Process *deleting_process)
6271 register Lisp_Object proc;
6272 Lisp_Object tail, msg;
6273 struct gcpro gcpro1, gcpro2;
6275 tail = Qnil;
6276 msg = Qnil;
6277 /* We need to gcpro tail; if read_process_output calls a filter
6278 which deletes a process and removes the cons to which tail points
6279 from Vprocess_alist, and then causes a GC, tail is an unprotected
6280 reference. */
6281 GCPRO2 (tail, msg);
6283 /* Set this now, so that if new processes are created by sentinels
6284 that we run, we get called again to handle their status changes. */
6285 update_tick = process_tick;
6287 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6289 Lisp_Object symbol;
6290 register struct Lisp_Process *p;
6292 proc = Fcdr (XCAR (tail));
6293 p = XPROCESS (proc);
6295 if (p->tick != p->update_tick)
6297 p->update_tick = p->tick;
6299 /* If process is still active, read any output that remains. */
6300 while (! EQ (p->filter, Qt)
6301 && ! EQ (p->status, Qconnect)
6302 && ! EQ (p->status, Qlisten)
6303 /* Network or serial process not stopped: */
6304 && ! EQ (p->command, Qt)
6305 && p->infd >= 0
6306 && p != deleting_process
6307 && read_process_output (proc, p->infd) > 0);
6309 /* Get the text to use for the message. */
6310 if (p->raw_status_new)
6311 update_status (p);
6312 msg = status_message (p);
6314 /* If process is terminated, deactivate it or delete it. */
6315 symbol = p->status;
6316 if (CONSP (p->status))
6317 symbol = XCAR (p->status);
6319 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6320 || EQ (symbol, Qclosed))
6322 if (delete_exited_processes)
6323 remove_process (proc);
6324 else
6325 deactivate_process (proc);
6328 /* The actions above may have further incremented p->tick.
6329 So set p->update_tick again so that an error in the sentinel will
6330 not cause this code to be run again. */
6331 p->update_tick = p->tick;
6332 /* Now output the message suitably. */
6333 exec_sentinel (proc, msg);
6335 } /* end for */
6337 update_mode_lines++; /* In case buffers use %s in mode-line-format. */
6338 UNGCPRO;
6341 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
6342 Sinternal_default_process_sentinel, 2, 2, 0,
6343 doc: /* Function used as default sentinel for processes. */)
6344 (Lisp_Object proc, Lisp_Object msg)
6346 Lisp_Object buffer, symbol;
6347 struct Lisp_Process *p;
6348 CHECK_PROCESS (proc);
6349 p = XPROCESS (proc);
6350 buffer = p->buffer;
6351 symbol = p->status;
6352 if (CONSP (symbol))
6353 symbol = XCAR (symbol);
6355 if (!EQ (symbol, Qrun) && !NILP (buffer))
6357 Lisp_Object tem;
6358 struct buffer *old = current_buffer;
6359 ptrdiff_t opoint, opoint_byte;
6360 ptrdiff_t before, before_byte;
6362 /* Avoid error if buffer is deleted
6363 (probably that's why the process is dead, too). */
6364 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
6365 return Qnil;
6366 Fset_buffer (buffer);
6368 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
6369 msg = (code_convert_string_norecord
6370 (msg, Vlocale_coding_system, 1));
6372 opoint = PT;
6373 opoint_byte = PT_BYTE;
6374 /* Insert new output into buffer
6375 at the current end-of-output marker,
6376 thus preserving logical ordering of input and output. */
6377 if (XMARKER (p->mark)->buffer)
6378 Fgoto_char (p->mark);
6379 else
6380 SET_PT_BOTH (ZV, ZV_BYTE);
6382 before = PT;
6383 before_byte = PT_BYTE;
6385 tem = BVAR (current_buffer, read_only);
6386 bset_read_only (current_buffer, Qnil);
6387 insert_string ("\nProcess ");
6388 { /* FIXME: temporary kludge. */
6389 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
6390 insert_string (" ");
6391 Finsert (1, &msg);
6392 bset_read_only (current_buffer, tem);
6393 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6395 if (opoint >= before)
6396 SET_PT_BOTH (opoint + (PT - before),
6397 opoint_byte + (PT_BYTE - before_byte));
6398 else
6399 SET_PT_BOTH (opoint, opoint_byte);
6401 set_buffer_internal (old);
6403 return Qnil;
6407 DEFUN ("set-process-coding-system", Fset_process_coding_system,
6408 Sset_process_coding_system, 1, 3, 0,
6409 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
6410 DECODING will be used to decode subprocess output and ENCODING to
6411 encode subprocess input. */)
6412 (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
6414 register struct Lisp_Process *p;
6416 CHECK_PROCESS (process);
6417 p = XPROCESS (process);
6418 if (p->infd < 0)
6419 error ("Input file descriptor of %s closed", SDATA (p->name));
6420 if (p->outfd < 0)
6421 error ("Output file descriptor of %s closed", SDATA (p->name));
6422 Fcheck_coding_system (decoding);
6423 Fcheck_coding_system (encoding);
6424 encoding = coding_inherit_eol_type (encoding, Qnil);
6425 pset_decode_coding_system (p, decoding);
6426 pset_encode_coding_system (p, encoding);
6427 setup_process_coding_systems (process);
6429 return Qnil;
6432 DEFUN ("process-coding-system",
6433 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
6434 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6435 (register Lisp_Object process)
6437 CHECK_PROCESS (process);
6438 return Fcons (XPROCESS (process)->decode_coding_system,
6439 XPROCESS (process)->encode_coding_system);
6442 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
6443 Sset_process_filter_multibyte, 2, 2, 0,
6444 doc: /* Set multibyteness of the strings given to PROCESS's filter.
6445 If FLAG is non-nil, the filter is given multibyte strings.
6446 If FLAG is nil, the filter is given unibyte strings. In this case,
6447 all character code conversion except for end-of-line conversion is
6448 suppressed. */)
6449 (Lisp_Object process, Lisp_Object flag)
6451 register struct Lisp_Process *p;
6453 CHECK_PROCESS (process);
6454 p = XPROCESS (process);
6455 if (NILP (flag))
6456 pset_decode_coding_system
6457 (p, raw_text_coding_system (p->decode_coding_system));
6458 setup_process_coding_systems (process);
6460 return Qnil;
6463 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6464 Sprocess_filter_multibyte_p, 1, 1, 0,
6465 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6466 (Lisp_Object process)
6468 register struct Lisp_Process *p;
6469 struct coding_system *coding;
6471 CHECK_PROCESS (process);
6472 p = XPROCESS (process);
6473 coding = proc_decode_coding_system[p->infd];
6474 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
6480 # ifdef HAVE_GPM
6482 void
6483 add_gpm_wait_descriptor (int desc)
6485 add_keyboard_wait_descriptor (desc);
6488 void
6489 delete_gpm_wait_descriptor (int desc)
6491 delete_keyboard_wait_descriptor (desc);
6494 # endif
6496 # ifdef USABLE_SIGIO
6498 /* Return true if *MASK has a bit set
6499 that corresponds to one of the keyboard input descriptors. */
6501 static bool
6502 keyboard_bit_set (fd_set *mask)
6504 int fd;
6506 for (fd = 0; fd <= max_input_desc; fd++)
6507 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
6508 && !FD_ISSET (fd, &non_keyboard_wait_mask))
6509 return 1;
6511 return 0;
6513 # endif
6515 #else /* not subprocesses */
6517 /* Defined on msdos.c. */
6518 extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
6519 EMACS_TIME *, void *);
6521 /* Implementation of wait_reading_process_output, assuming that there
6522 are no subprocesses. Used only by the MS-DOS build.
6524 Wait for timeout to elapse and/or keyboard input to be available.
6526 TIME_LIMIT is:
6527 timeout in seconds
6528 If negative, gobble data immediately available but don't wait for any.
6530 NSECS is:
6531 an additional duration to wait, measured in nanoseconds
6532 If TIME_LIMIT is zero, then:
6533 If NSECS == 0, there is no limit.
6534 If NSECS > 0, the timeout consists of NSECS only.
6535 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
6537 READ_KBD is:
6538 0 to ignore keyboard input, or
6539 1 to return when input is available, or
6540 -1 means caller will actually read the input, so don't throw to
6541 the quit handler.
6543 see full version for other parameters. We know that wait_proc will
6544 always be NULL, since `subprocesses' isn't defined.
6546 DO_DISPLAY means redisplay should be done to show subprocess
6547 output that arrives.
6549 Return true if we received input from any process. */
6551 bool
6552 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
6553 bool do_display,
6554 Lisp_Object wait_for_cell,
6555 struct Lisp_Process *wait_proc, int just_wait_proc)
6557 register int nfds;
6558 EMACS_TIME end_time, timeout;
6560 if (time_limit < 0)
6562 time_limit = 0;
6563 nsecs = -1;
6565 else if (TYPE_MAXIMUM (time_t) < time_limit)
6566 time_limit = TYPE_MAXIMUM (time_t);
6568 /* What does time_limit really mean? */
6569 if (time_limit || nsecs > 0)
6571 timeout = make_emacs_time (time_limit, nsecs);
6572 end_time = add_emacs_time (current_emacs_time (), timeout);
6575 /* Turn off periodic alarms (in case they are in use)
6576 and then turn off any other atimers,
6577 because the select emulator uses alarms. */
6578 stop_polling ();
6579 turn_on_atimers (0);
6581 while (1)
6583 bool timeout_reduced_for_timers = 0;
6584 SELECT_TYPE waitchannels;
6585 int xerrno;
6587 /* If calling from keyboard input, do not quit
6588 since we want to return C-g as an input character.
6589 Otherwise, do pending quit if requested. */
6590 if (read_kbd >= 0)
6591 QUIT;
6593 /* Exit now if the cell we're waiting for became non-nil. */
6594 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6595 break;
6597 /* Compute time from now till when time limit is up. */
6598 /* Exit if already run out. */
6599 if (nsecs < 0)
6601 /* A negative timeout means
6602 gobble output available now
6603 but don't wait at all. */
6605 timeout = make_emacs_time (0, 0);
6607 else if (time_limit || nsecs > 0)
6609 EMACS_TIME now = current_emacs_time ();
6610 if (EMACS_TIME_LE (end_time, now))
6611 break;
6612 timeout = sub_emacs_time (end_time, now);
6614 else
6616 timeout = make_emacs_time (100000, 0);
6619 /* If our caller will not immediately handle keyboard events,
6620 run timer events directly.
6621 (Callers that will immediately read keyboard events
6622 call timer_delay on their own.) */
6623 if (NILP (wait_for_cell))
6625 EMACS_TIME timer_delay;
6629 unsigned old_timers_run = timers_run;
6630 timer_delay = timer_check ();
6631 if (timers_run != old_timers_run && do_display)
6632 /* We must retry, since a timer may have requeued itself
6633 and that could alter the time delay. */
6634 redisplay_preserve_echo_area (14);
6635 else
6636 break;
6638 while (!detect_input_pending ());
6640 /* If there is unread keyboard input, also return. */
6641 if (read_kbd != 0
6642 && requeued_events_pending_p ())
6643 break;
6645 if (EMACS_TIME_VALID_P (timer_delay) && nsecs >= 0)
6647 if (EMACS_TIME_LT (timer_delay, timeout))
6649 timeout = timer_delay;
6650 timeout_reduced_for_timers = 1;
6655 /* Cause C-g and alarm signals to take immediate action,
6656 and cause input available signals to zero out timeout. */
6657 if (read_kbd < 0)
6658 set_waiting_for_input (&timeout);
6660 /* If a frame has been newly mapped and needs updating,
6661 reprocess its display stuff. */
6662 if (frame_garbaged && do_display)
6664 clear_waiting_for_input ();
6665 redisplay_preserve_echo_area (15);
6666 if (read_kbd < 0)
6667 set_waiting_for_input (&timeout);
6670 /* Wait till there is something to do. */
6671 FD_ZERO (&waitchannels);
6672 if (read_kbd && detect_input_pending ())
6673 nfds = 0;
6674 else
6676 if (read_kbd || !NILP (wait_for_cell))
6677 FD_SET (0, &waitchannels);
6678 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
6681 xerrno = errno;
6683 /* Make C-g and alarm signals set flags again */
6684 clear_waiting_for_input ();
6686 /* If we woke up due to SIGWINCH, actually change size now. */
6687 do_pending_window_change (0);
6689 if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
6690 /* We waited the full specified time, so return now. */
6691 break;
6693 if (nfds == -1)
6695 /* If the system call was interrupted, then go around the
6696 loop again. */
6697 if (xerrno == EINTR)
6698 FD_ZERO (&waitchannels);
6699 else
6700 report_file_errno ("Failed select", Qnil, xerrno);
6703 /* Check for keyboard input */
6705 if (read_kbd
6706 && detect_input_pending_run_timers (do_display))
6708 swallow_events (do_display);
6709 if (detect_input_pending_run_timers (do_display))
6710 break;
6713 /* If there is unread keyboard input, also return. */
6714 if (read_kbd
6715 && requeued_events_pending_p ())
6716 break;
6718 /* If wait_for_cell. check for keyboard input
6719 but don't run any timers.
6720 ??? (It seems wrong to me to check for keyboard
6721 input at all when wait_for_cell, but the code
6722 has been this way since July 1994.
6723 Try changing this after version 19.31.) */
6724 if (! NILP (wait_for_cell)
6725 && detect_input_pending ())
6727 swallow_events (do_display);
6728 if (detect_input_pending ())
6729 break;
6732 /* Exit now if the cell we're waiting for became non-nil. */
6733 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6734 break;
6737 start_polling ();
6739 return 0;
6742 #endif /* not subprocesses */
6744 /* The following functions are needed even if async subprocesses are
6745 not supported. Some of them are no-op stubs in that case. */
6747 /* Add DESC to the set of keyboard input descriptors. */
6749 void
6750 add_keyboard_wait_descriptor (int desc)
6752 #ifdef subprocesses /* actually means "not MSDOS" */
6753 FD_SET (desc, &input_wait_mask);
6754 FD_SET (desc, &non_process_wait_mask);
6755 if (desc > max_input_desc)
6756 max_input_desc = desc;
6757 #endif
6760 /* From now on, do not expect DESC to give keyboard input. */
6762 void
6763 delete_keyboard_wait_descriptor (int desc)
6765 #ifdef subprocesses
6766 int fd;
6767 int lim = max_input_desc;
6769 FD_CLR (desc, &input_wait_mask);
6770 FD_CLR (desc, &non_process_wait_mask);
6772 if (desc == max_input_desc)
6773 for (fd = 0; fd < lim; fd++)
6774 if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
6775 max_input_desc = fd;
6776 #endif
6779 /* Setup coding systems of PROCESS. */
6781 void
6782 setup_process_coding_systems (Lisp_Object process)
6784 #ifdef subprocesses
6785 struct Lisp_Process *p = XPROCESS (process);
6786 int inch = p->infd;
6787 int outch = p->outfd;
6788 Lisp_Object coding_system;
6790 if (inch < 0 || outch < 0)
6791 return;
6793 if (!proc_decode_coding_system[inch])
6794 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
6795 coding_system = p->decode_coding_system;
6796 if (EQ (p->filter, Qinternal_default_process_filter)
6797 && BUFFERP (p->buffer))
6799 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
6800 coding_system = raw_text_coding_system (coding_system);
6802 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
6804 if (!proc_encode_coding_system[outch])
6805 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
6806 setup_coding_system (p->encode_coding_system,
6807 proc_encode_coding_system[outch]);
6808 #endif
6811 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
6812 doc: /* Return the (or a) process associated with BUFFER.
6813 BUFFER may be a buffer or the name of one. */)
6814 (register Lisp_Object buffer)
6816 #ifdef subprocesses
6817 register Lisp_Object buf, tail, proc;
6819 if (NILP (buffer)) return Qnil;
6820 buf = Fget_buffer (buffer);
6821 if (NILP (buf)) return Qnil;
6823 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6825 proc = Fcdr (XCAR (tail));
6826 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
6827 return proc;
6829 #endif /* subprocesses */
6830 return Qnil;
6833 DEFUN ("process-inherit-coding-system-flag",
6834 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
6835 1, 1, 0,
6836 doc: /* Return the value of inherit-coding-system flag for PROCESS.
6837 If this flag is t, `buffer-file-coding-system' of the buffer
6838 associated with PROCESS will inherit the coding system used to decode
6839 the process output. */)
6840 (register Lisp_Object process)
6842 #ifdef subprocesses
6843 CHECK_PROCESS (process);
6844 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
6845 #else
6846 /* Ignore the argument and return the value of
6847 inherit-process-coding-system. */
6848 return inherit_process_coding_system ? Qt : Qnil;
6849 #endif
6852 /* Kill all processes associated with `buffer'.
6853 If `buffer' is nil, kill all processes */
6855 void
6856 kill_buffer_processes (Lisp_Object buffer)
6858 #ifdef subprocesses
6859 Lisp_Object tail, proc;
6861 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6863 proc = XCDR (XCAR (tail));
6864 if (PROCESSP (proc)
6865 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
6867 if (NETCONN_P (proc) || SERIALCONN_P (proc))
6868 Fdelete_process (proc);
6869 else if (XPROCESS (proc)->infd >= 0)
6870 process_send_signal (proc, SIGHUP, Qnil, 1);
6873 #else /* subprocesses */
6874 /* Since we have no subprocesses, this does nothing. */
6875 #endif /* subprocesses */
6878 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
6879 Swaiting_for_user_input_p, 0, 0, 0,
6880 doc: /* Return non-nil if Emacs is waiting for input from the user.
6881 This is intended for use by asynchronous process output filters and sentinels. */)
6882 (void)
6884 #ifdef subprocesses
6885 return (waiting_for_user_input_p ? Qt : Qnil);
6886 #else
6887 return Qnil;
6888 #endif
6891 /* Stop reading input from keyboard sources. */
6893 void
6894 hold_keyboard_input (void)
6896 kbd_is_on_hold = 1;
6899 /* Resume reading input from keyboard sources. */
6901 void
6902 unhold_keyboard_input (void)
6904 kbd_is_on_hold = 0;
6907 /* Return true if keyboard input is on hold, zero otherwise. */
6909 bool
6910 kbd_on_hold_p (void)
6912 return kbd_is_on_hold;
6916 /* Enumeration of and access to system processes a-la ps(1). */
6918 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
6919 0, 0, 0,
6920 doc: /* Return a list of numerical process IDs of all running processes.
6921 If this functionality is unsupported, return nil.
6923 See `process-attributes' for getting attributes of a process given its ID. */)
6924 (void)
6926 return list_system_processes ();
6929 DEFUN ("process-attributes", Fprocess_attributes,
6930 Sprocess_attributes, 1, 1, 0,
6931 doc: /* Return attributes of the process given by its PID, a number.
6933 Value is an alist where each element is a cons cell of the form
6935 \(KEY . VALUE)
6937 If this functionality is unsupported, the value is nil.
6939 See `list-system-processes' for getting a list of all process IDs.
6941 The KEYs of the attributes that this function may return are listed
6942 below, together with the type of the associated VALUE (in parentheses).
6943 Not all platforms support all of these attributes; unsupported
6944 attributes will not appear in the returned alist.
6945 Unless explicitly indicated otherwise, numbers can have either
6946 integer or floating point values.
6948 euid -- Effective user User ID of the process (number)
6949 user -- User name corresponding to euid (string)
6950 egid -- Effective user Group ID of the process (number)
6951 group -- Group name corresponding to egid (string)
6952 comm -- Command name (executable name only) (string)
6953 state -- Process state code, such as "S", "R", or "T" (string)
6954 ppid -- Parent process ID (number)
6955 pgrp -- Process group ID (number)
6956 sess -- Session ID, i.e. process ID of session leader (number)
6957 ttname -- Controlling tty name (string)
6958 tpgid -- ID of foreground process group on the process's tty (number)
6959 minflt -- number of minor page faults (number)
6960 majflt -- number of major page faults (number)
6961 cminflt -- cumulative number of minor page faults (number)
6962 cmajflt -- cumulative number of major page faults (number)
6963 utime -- user time used by the process, in (current-time) format,
6964 which is a list of integers (HIGH LOW USEC PSEC)
6965 stime -- system time used by the process (current-time)
6966 time -- sum of utime and stime (current-time)
6967 cutime -- user time used by the process and its children (current-time)
6968 cstime -- system time used by the process and its children (current-time)
6969 ctime -- sum of cutime and cstime (current-time)
6970 pri -- priority of the process (number)
6971 nice -- nice value of the process (number)
6972 thcount -- process thread count (number)
6973 start -- time the process started (current-time)
6974 vsize -- virtual memory size of the process in KB's (number)
6975 rss -- resident set size of the process in KB's (number)
6976 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
6977 pcpu -- percents of CPU time used by the process (floating-point number)
6978 pmem -- percents of total physical memory used by process's resident set
6979 (floating-point number)
6980 args -- command line which invoked the process (string). */)
6981 ( Lisp_Object pid)
6983 return system_process_attributes (pid);
6986 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
6987 Invoke this after init_process_emacs, and after glib and/or GNUstep
6988 futz with the SIGCHLD handler, but before Emacs forks any children.
6989 This function's caller should block SIGCHLD. */
6991 #ifndef NS_IMPL_GNUSTEP
6992 static
6993 #endif
6994 void
6995 catch_child_signal (void)
6997 struct sigaction action, old_action;
6998 emacs_sigaction_init (&action, deliver_child_signal);
6999 block_child_signal ();
7000 sigaction (SIGCHLD, &action, &old_action);
7001 eassert (! (old_action.sa_flags & SA_SIGINFO));
7003 if (old_action.sa_handler != deliver_child_signal)
7004 lib_child_handler
7005 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7006 ? dummy_handler
7007 : old_action.sa_handler);
7008 unblock_child_signal ();
7012 /* This is not called "init_process" because that is the name of a
7013 Mach system call, so it would cause problems on Darwin systems. */
7014 void
7015 init_process_emacs (void)
7017 #ifdef subprocesses
7018 register int i;
7020 inhibit_sentinels = 0;
7022 #ifndef CANNOT_DUMP
7023 if (! noninteractive || initialized)
7024 #endif
7026 #if defined HAVE_GLIB && !defined WINDOWSNT
7027 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7028 this should always fail, but is enough to initialize glib's
7029 private SIGCHLD handler, allowing catch_child_signal to copy
7030 it into lib_child_handler. */
7031 g_source_unref (g_child_watch_source_new (getpid ()));
7032 #endif
7033 catch_child_signal ();
7036 FD_ZERO (&input_wait_mask);
7037 FD_ZERO (&non_keyboard_wait_mask);
7038 FD_ZERO (&non_process_wait_mask);
7039 FD_ZERO (&write_mask);
7040 max_process_desc = 0;
7041 memset (fd_callback_info, 0, sizeof (fd_callback_info));
7043 #ifdef NON_BLOCKING_CONNECT
7044 FD_ZERO (&connect_wait_mask);
7045 num_pending_connects = 0;
7046 #endif
7048 #ifdef ADAPTIVE_READ_BUFFERING
7049 process_output_delay_count = 0;
7050 process_output_skip = 0;
7051 #endif
7053 /* Don't do this, it caused infinite select loops. The display
7054 method should call add_keyboard_wait_descriptor on stdin if it
7055 needs that. */
7056 #if 0
7057 FD_SET (0, &input_wait_mask);
7058 #endif
7060 Vprocess_alist = Qnil;
7061 deleted_pid_list = Qnil;
7062 for (i = 0; i < MAXDESC; i++)
7064 chan_process[i] = Qnil;
7065 proc_buffered_char[i] = -1;
7067 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
7068 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
7069 #ifdef DATAGRAM_SOCKETS
7070 memset (datagram_address, 0, sizeof datagram_address);
7071 #endif
7074 Lisp_Object subfeatures = Qnil;
7075 const struct socket_options *sopt;
7077 #define ADD_SUBFEATURE(key, val) \
7078 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7080 #ifdef NON_BLOCKING_CONNECT
7081 ADD_SUBFEATURE (QCnowait, Qt);
7082 #endif
7083 #ifdef DATAGRAM_SOCKETS
7084 ADD_SUBFEATURE (QCtype, Qdatagram);
7085 #endif
7086 #ifdef HAVE_SEQPACKET
7087 ADD_SUBFEATURE (QCtype, Qseqpacket);
7088 #endif
7089 #ifdef HAVE_LOCAL_SOCKETS
7090 ADD_SUBFEATURE (QCfamily, Qlocal);
7091 #endif
7092 ADD_SUBFEATURE (QCfamily, Qipv4);
7093 #ifdef AF_INET6
7094 ADD_SUBFEATURE (QCfamily, Qipv6);
7095 #endif
7096 #ifdef HAVE_GETSOCKNAME
7097 ADD_SUBFEATURE (QCservice, Qt);
7098 #endif
7099 ADD_SUBFEATURE (QCserver, Qt);
7101 for (sopt = socket_options; sopt->name; sopt++)
7102 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
7104 Fprovide (intern_c_string ("make-network-process"), subfeatures);
7107 #if defined (DARWIN_OS)
7108 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7109 processes. As such, we only change the default value. */
7110 if (initialized)
7112 char const *release = (STRINGP (Voperating_system_release)
7113 ? SSDATA (Voperating_system_release)
7114 : 0);
7115 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
7116 Vprocess_connection_type = Qnil;
7119 #endif
7120 #endif /* subprocesses */
7121 kbd_is_on_hold = 0;
7124 void
7125 syms_of_process (void)
7127 #ifdef subprocesses
7129 DEFSYM (Qprocessp, "processp");
7130 DEFSYM (Qrun, "run");
7131 DEFSYM (Qstop, "stop");
7132 DEFSYM (Qsignal, "signal");
7134 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7135 here again.
7137 Qexit = intern_c_string ("exit");
7138 staticpro (&Qexit); */
7140 DEFSYM (Qopen, "open");
7141 DEFSYM (Qclosed, "closed");
7142 DEFSYM (Qconnect, "connect");
7143 DEFSYM (Qfailed, "failed");
7144 DEFSYM (Qlisten, "listen");
7145 DEFSYM (Qlocal, "local");
7146 DEFSYM (Qipv4, "ipv4");
7147 #ifdef AF_INET6
7148 DEFSYM (Qipv6, "ipv6");
7149 #endif
7150 DEFSYM (Qdatagram, "datagram");
7151 DEFSYM (Qseqpacket, "seqpacket");
7153 DEFSYM (QCport, ":port");
7154 DEFSYM (QCspeed, ":speed");
7155 DEFSYM (QCprocess, ":process");
7157 DEFSYM (QCbytesize, ":bytesize");
7158 DEFSYM (QCstopbits, ":stopbits");
7159 DEFSYM (QCparity, ":parity");
7160 DEFSYM (Qodd, "odd");
7161 DEFSYM (Qeven, "even");
7162 DEFSYM (QCflowcontrol, ":flowcontrol");
7163 DEFSYM (Qhw, "hw");
7164 DEFSYM (Qsw, "sw");
7165 DEFSYM (QCsummary, ":summary");
7167 DEFSYM (Qreal, "real");
7168 DEFSYM (Qnetwork, "network");
7169 DEFSYM (Qserial, "serial");
7170 DEFSYM (QCbuffer, ":buffer");
7171 DEFSYM (QChost, ":host");
7172 DEFSYM (QCservice, ":service");
7173 DEFSYM (QClocal, ":local");
7174 DEFSYM (QCremote, ":remote");
7175 DEFSYM (QCcoding, ":coding");
7176 DEFSYM (QCserver, ":server");
7177 DEFSYM (QCnowait, ":nowait");
7178 DEFSYM (QCsentinel, ":sentinel");
7179 DEFSYM (QClog, ":log");
7180 DEFSYM (QCnoquery, ":noquery");
7181 DEFSYM (QCstop, ":stop");
7182 DEFSYM (QCoptions, ":options");
7183 DEFSYM (QCplist, ":plist");
7185 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
7187 staticpro (&Vprocess_alist);
7188 staticpro (&deleted_pid_list);
7190 #endif /* subprocesses */
7192 DEFSYM (QCname, ":name");
7193 DEFSYM (QCtype, ":type");
7195 DEFSYM (Qeuid, "euid");
7196 DEFSYM (Qegid, "egid");
7197 DEFSYM (Quser, "user");
7198 DEFSYM (Qgroup, "group");
7199 DEFSYM (Qcomm, "comm");
7200 DEFSYM (Qstate, "state");
7201 DEFSYM (Qppid, "ppid");
7202 DEFSYM (Qpgrp, "pgrp");
7203 DEFSYM (Qsess, "sess");
7204 DEFSYM (Qttname, "ttname");
7205 DEFSYM (Qtpgid, "tpgid");
7206 DEFSYM (Qminflt, "minflt");
7207 DEFSYM (Qmajflt, "majflt");
7208 DEFSYM (Qcminflt, "cminflt");
7209 DEFSYM (Qcmajflt, "cmajflt");
7210 DEFSYM (Qutime, "utime");
7211 DEFSYM (Qstime, "stime");
7212 DEFSYM (Qtime, "time");
7213 DEFSYM (Qcutime, "cutime");
7214 DEFSYM (Qcstime, "cstime");
7215 DEFSYM (Qctime, "ctime");
7216 DEFSYM (Qinternal_default_process_sentinel,
7217 "internal-default-process-sentinel");
7218 DEFSYM (Qinternal_default_process_filter,
7219 "internal-default-process-filter");
7220 DEFSYM (Qpri, "pri");
7221 DEFSYM (Qnice, "nice");
7222 DEFSYM (Qthcount, "thcount");
7223 DEFSYM (Qstart, "start");
7224 DEFSYM (Qvsize, "vsize");
7225 DEFSYM (Qrss, "rss");
7226 DEFSYM (Qetime, "etime");
7227 DEFSYM (Qpcpu, "pcpu");
7228 DEFSYM (Qpmem, "pmem");
7229 DEFSYM (Qargs, "args");
7231 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
7232 doc: /* Non-nil means delete processes immediately when they exit.
7233 A value of nil means don't delete them until `list-processes' is run. */);
7235 delete_exited_processes = 1;
7237 #ifdef subprocesses
7238 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
7239 doc: /* Control type of device used to communicate with subprocesses.
7240 Values are nil to use a pipe, or t or `pty' to use a pty.
7241 The value has no effect if the system has no ptys or if all ptys are busy:
7242 then a pipe is used in any case.
7243 The value takes effect when `start-process' is called. */);
7244 Vprocess_connection_type = Qt;
7246 #ifdef ADAPTIVE_READ_BUFFERING
7247 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
7248 doc: /* If non-nil, improve receive buffering by delaying after short reads.
7249 On some systems, when Emacs reads the output from a subprocess, the output data
7250 is read in very small blocks, potentially resulting in very poor performance.
7251 This behavior can be remedied to some extent by setting this variable to a
7252 non-nil value, as it will automatically delay reading from such processes, to
7253 allow them to produce more output before Emacs tries to read it.
7254 If the value is t, the delay is reset after each write to the process; any other
7255 non-nil value means that the delay is not reset on write.
7256 The variable takes effect when `start-process' is called. */);
7257 Vprocess_adaptive_read_buffering = Qt;
7258 #endif
7260 defsubr (&Sprocessp);
7261 defsubr (&Sget_process);
7262 defsubr (&Sdelete_process);
7263 defsubr (&Sprocess_status);
7264 defsubr (&Sprocess_exit_status);
7265 defsubr (&Sprocess_id);
7266 defsubr (&Sprocess_name);
7267 defsubr (&Sprocess_tty_name);
7268 defsubr (&Sprocess_command);
7269 defsubr (&Sset_process_buffer);
7270 defsubr (&Sprocess_buffer);
7271 defsubr (&Sprocess_mark);
7272 defsubr (&Sset_process_filter);
7273 defsubr (&Sprocess_filter);
7274 defsubr (&Sset_process_sentinel);
7275 defsubr (&Sprocess_sentinel);
7276 defsubr (&Sset_process_window_size);
7277 defsubr (&Sset_process_inherit_coding_system_flag);
7278 defsubr (&Sset_process_query_on_exit_flag);
7279 defsubr (&Sprocess_query_on_exit_flag);
7280 defsubr (&Sprocess_contact);
7281 defsubr (&Sprocess_plist);
7282 defsubr (&Sset_process_plist);
7283 defsubr (&Sprocess_list);
7284 defsubr (&Sstart_process);
7285 defsubr (&Sserial_process_configure);
7286 defsubr (&Smake_serial_process);
7287 defsubr (&Sset_network_process_option);
7288 defsubr (&Smake_network_process);
7289 defsubr (&Sformat_network_address);
7290 #if defined (HAVE_NET_IF_H)
7291 #ifdef SIOCGIFCONF
7292 defsubr (&Snetwork_interface_list);
7293 #endif
7294 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
7295 defsubr (&Snetwork_interface_info);
7296 #endif
7297 #endif /* defined (HAVE_NET_IF_H) */
7298 #ifdef DATAGRAM_SOCKETS
7299 defsubr (&Sprocess_datagram_address);
7300 defsubr (&Sset_process_datagram_address);
7301 #endif
7302 defsubr (&Saccept_process_output);
7303 defsubr (&Sprocess_send_region);
7304 defsubr (&Sprocess_send_string);
7305 defsubr (&Sinterrupt_process);
7306 defsubr (&Skill_process);
7307 defsubr (&Squit_process);
7308 defsubr (&Sstop_process);
7309 defsubr (&Scontinue_process);
7310 defsubr (&Sprocess_running_child_p);
7311 defsubr (&Sprocess_send_eof);
7312 defsubr (&Ssignal_process);
7313 defsubr (&Swaiting_for_user_input_p);
7314 defsubr (&Sprocess_type);
7315 defsubr (&Sinternal_default_process_sentinel);
7316 defsubr (&Sinternal_default_process_filter);
7317 defsubr (&Sset_process_coding_system);
7318 defsubr (&Sprocess_coding_system);
7319 defsubr (&Sset_process_filter_multibyte);
7320 defsubr (&Sprocess_filter_multibyte_p);
7322 #endif /* subprocesses */
7324 defsubr (&Sget_buffer_process);
7325 defsubr (&Sprocess_inherit_coding_system_flag);
7326 defsubr (&Slist_system_processes);
7327 defsubr (&Sprocess_attributes);