1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2012
4 Free Software 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/>. */
24 #define PROCESS_INLINE EXTERN_INLINE
29 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
39 /* Only MS-DOS does not define `subprocesses'. */
42 #include <sys/socket.h>
44 #include <netinet/in.h>
45 #include <arpa/inet.h>
47 /* Are local (unix) sockets supported? */
48 #if defined (HAVE_SYS_UN_H)
49 #if !defined (AF_LOCAL) && defined (AF_UNIX)
50 #define AF_LOCAL AF_UNIX
53 #define HAVE_LOCAL_SOCKETS
58 #include <sys/ioctl.h>
59 #if defined (HAVE_NET_IF_H)
61 #endif /* HAVE_NET_IF_H */
63 #if defined (HAVE_IFADDRS_H)
64 /* Must be after net/if.h */
67 /* We only use structs from this header when we use getifaddrs. */
68 #if defined (HAVE_NET_IF_DL_H)
69 #include <net/if_dl.h>
79 #include <netinet/in.h>
80 #include <arpa/nameser.h>
92 #endif /* subprocesses */
98 #include "character.h"
103 #include "termhooks.h"
104 #include "termopts.h"
105 #include "commands.h"
106 #include "keyboard.h"
107 #include "blockinput.h"
108 #include "dispextern.h"
109 #include "composite.h"
111 #include "sysselect.h"
112 #include "syssignal.h"
118 #ifdef HAVE_WINDOW_SYSTEM
120 #endif /* HAVE_WINDOW_SYSTEM */
122 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
123 #include "xgselect.h"
128 # define waitpid(pid, status, options) wait (status)
134 /* Work around GCC 4.7.0 bug with strict overflow checking; see
135 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
136 These lines can be removed once the GCC bug is fixed. */
137 #if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
138 # pragma GCC diagnostic ignored "-Wstrict-overflow"
141 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
142 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
143 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
144 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
145 Lisp_Object QCname
, QCtype
;
147 /* Non-zero if keyboard input is on hold, zero otherwise. */
149 static int kbd_is_on_hold
;
151 /* Nonzero means don't run process sentinels. This is used
153 int inhibit_sentinels
;
157 Lisp_Object Qprocessp
;
158 static Lisp_Object Qrun
, Qstop
, Qsignal
;
159 static Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
161 static Lisp_Object Qipv4
, Qdatagram
, Qseqpacket
;
162 static Lisp_Object Qreal
, Qnetwork
, Qserial
;
164 static Lisp_Object Qipv6
;
166 static Lisp_Object QCport
, QCprocess
;
168 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
169 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
170 static Lisp_Object QCbuffer
, QChost
, QCservice
;
171 static Lisp_Object QClocal
, QCremote
, QCcoding
;
172 static Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
173 static Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
174 static Lisp_Object Qlast_nonmenu_event
;
176 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
177 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
178 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
179 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
185 /* Number of events of change of status of a process. */
186 static EMACS_INT process_tick
;
187 /* Number of events for which the user or sentinel has been notified. */
188 static EMACS_INT update_tick
;
190 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
192 /* Only W32 has this, it really means that select can't take write mask. */
193 #ifdef BROKEN_NON_BLOCKING_CONNECT
194 #undef NON_BLOCKING_CONNECT
195 #define SELECT_CANT_DO_WRITE_MASK
197 #ifndef NON_BLOCKING_CONNECT
199 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
200 #if defined (O_NONBLOCK) || defined (O_NDELAY)
201 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
202 #define NON_BLOCKING_CONNECT
203 #endif /* EWOULDBLOCK || EINPROGRESS */
204 #endif /* O_NONBLOCK || O_NDELAY */
205 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
206 #endif /* HAVE_SELECT */
207 #endif /* NON_BLOCKING_CONNECT */
208 #endif /* BROKEN_NON_BLOCKING_CONNECT */
210 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
211 this system. We need to read full packets, so we need a
212 "non-destructive" select. So we require either native select,
213 or emulation of select using FIONREAD. */
215 #ifdef BROKEN_DATAGRAM_SOCKETS
216 #undef DATAGRAM_SOCKETS
218 #ifndef DATAGRAM_SOCKETS
219 #if defined (HAVE_SELECT) || defined (FIONREAD)
220 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
221 #define DATAGRAM_SOCKETS
222 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
223 #endif /* HAVE_SELECT || FIONREAD */
224 #endif /* DATAGRAM_SOCKETS */
225 #endif /* BROKEN_DATAGRAM_SOCKETS */
227 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
228 # define HAVE_SEQPACKET
231 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
232 #define ADAPTIVE_READ_BUFFERING
235 #ifdef ADAPTIVE_READ_BUFFERING
236 #define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
237 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
238 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
240 /* Number of processes which have a non-zero read_output_delay,
241 and therefore might be delayed for adaptive read buffering. */
243 static int process_output_delay_count
;
245 /* Non-zero if any process has non-nil read_output_skip. */
247 static int process_output_skip
;
250 #define process_output_delay_count 0
253 static void create_process (Lisp_Object
, char **, Lisp_Object
);
255 static int keyboard_bit_set (SELECT_TYPE
*);
257 static void deactivate_process (Lisp_Object
);
258 static void status_notify (struct Lisp_Process
*);
259 static int read_process_output (Lisp_Object
, int);
260 static void create_pty (Lisp_Object
);
262 /* If we support a window system, turn on the code to poll periodically
263 to detect C-g. It isn't actually used when doing interrupt input. */
264 #if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
265 #define POLL_FOR_INPUT
268 static Lisp_Object
get_process (register Lisp_Object name
);
269 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
271 /* Mask of bits indicating the descriptors that we wait for input on. */
273 static SELECT_TYPE input_wait_mask
;
275 /* Mask that excludes keyboard input descriptor(s). */
277 static SELECT_TYPE non_keyboard_wait_mask
;
279 /* Mask that excludes process input descriptor(s). */
281 static SELECT_TYPE non_process_wait_mask
;
283 /* Mask for selecting for write. */
285 static SELECT_TYPE write_mask
;
287 #ifdef NON_BLOCKING_CONNECT
288 /* Mask of bits indicating the descriptors that we wait for connect to
289 complete on. Once they complete, they are removed from this mask
290 and added to the input_wait_mask and non_keyboard_wait_mask. */
292 static SELECT_TYPE connect_wait_mask
;
294 /* Number of bits set in connect_wait_mask. */
295 static int num_pending_connects
;
296 #endif /* NON_BLOCKING_CONNECT */
298 /* The largest descriptor currently in use for a process object. */
299 static int max_process_desc
;
301 /* The largest descriptor currently in use for input. */
302 static int max_input_desc
;
304 /* Indexed by descriptor, gives the process (if any) for that descriptor */
305 static Lisp_Object chan_process
[MAXDESC
];
307 /* Alist of elements (NAME . PROCESS) */
308 static Lisp_Object Vprocess_alist
;
310 /* Buffered-ahead input char from process, indexed by channel.
311 -1 means empty (no char is buffered).
312 Used on sys V where the only way to tell if there is any
313 output from the process is to read at least one char.
314 Always -1 on systems that support FIONREAD. */
316 static int proc_buffered_char
[MAXDESC
];
318 /* Table of `struct coding-system' for each process. */
319 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
320 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
322 #ifdef DATAGRAM_SOCKETS
323 /* Table of `partner address' for datagram sockets. */
324 static struct sockaddr_and_len
{
327 } datagram_address
[MAXDESC
];
328 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
329 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
331 #define DATAGRAM_CHAN_P(chan) (0)
332 #define DATAGRAM_CONN_P(proc) (0)
335 /* Maximum number of bytes to send to a pty without an eof. */
336 static int pty_max_bytes
;
338 /* These setters are used only in this file, so they can be private. */
340 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
345 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
350 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
352 p
->decode_coding_system
= val
;
355 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
357 p
->decoding_buf
= val
;
360 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
362 p
->encode_coding_system
= val
;
365 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
367 p
->encoding_buf
= val
;
370 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
375 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
380 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
385 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
390 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
395 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
400 pset_status (struct Lisp_Process
*p
, Lisp_Object val
)
405 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
410 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
415 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
417 p
->write_queue
= val
;
422 static struct fd_callback_data
428 int condition
; /* mask of the defines above. */
429 } fd_callback_info
[MAXDESC
];
432 /* Add a file descriptor FD to be monitored for when read is possible.
433 When read is possible, call FUNC with argument DATA. */
436 add_read_fd (int fd
, fd_callback func
, void *data
)
438 eassert (fd
< MAXDESC
);
439 add_keyboard_wait_descriptor (fd
);
441 fd_callback_info
[fd
].func
= func
;
442 fd_callback_info
[fd
].data
= data
;
443 fd_callback_info
[fd
].condition
|= FOR_READ
;
446 /* Stop monitoring file descriptor FD for when read is possible. */
449 delete_read_fd (int fd
)
451 eassert (fd
< MAXDESC
);
452 delete_keyboard_wait_descriptor (fd
);
454 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
455 if (fd_callback_info
[fd
].condition
== 0)
457 fd_callback_info
[fd
].func
= 0;
458 fd_callback_info
[fd
].data
= 0;
462 /* Add a file descriptor FD to be monitored for when write is possible.
463 When write is possible, call FUNC with argument DATA. */
466 add_write_fd (int fd
, fd_callback func
, void *data
)
468 eassert (fd
< MAXDESC
);
469 FD_SET (fd
, &write_mask
);
470 if (fd
> max_input_desc
)
473 fd_callback_info
[fd
].func
= func
;
474 fd_callback_info
[fd
].data
= data
;
475 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
478 /* Stop monitoring file descriptor FD for when write is possible. */
481 delete_write_fd (int fd
)
483 int lim
= max_input_desc
;
485 eassert (fd
< MAXDESC
);
486 FD_CLR (fd
, &write_mask
);
487 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
488 if (fd_callback_info
[fd
].condition
== 0)
490 fd_callback_info
[fd
].func
= 0;
491 fd_callback_info
[fd
].data
= 0;
493 if (fd
== max_input_desc
)
494 for (fd
= lim
; fd
>= 0; fd
--)
495 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
505 /* Compute the Lisp form of the process status, p->status, from
506 the numeric status that was returned by `wait'. */
508 static Lisp_Object
status_convert (int);
511 update_status (struct Lisp_Process
*p
)
513 eassert (p
->raw_status_new
);
514 pset_status (p
, status_convert (p
->raw_status
));
515 p
->raw_status_new
= 0;
518 /* Convert a process status word in Unix format to
519 the list that we use internally. */
522 status_convert (int w
)
525 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
526 else if (WIFEXITED (w
))
527 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
528 WCOREDUMP (w
) ? Qt
: Qnil
));
529 else if (WIFSIGNALED (w
))
530 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
531 WCOREDUMP (w
) ? Qt
: Qnil
));
536 /* Given a status-list, extract the three pieces of information
537 and store them individually through the three pointers. */
540 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
554 *code
= XFASTINT (XCAR (tem
));
556 *coredump
= !NILP (tem
);
560 /* Return a string describing a process status list. */
563 status_message (struct Lisp_Process
*p
)
565 Lisp_Object status
= p
->status
;
568 Lisp_Object string
, string2
;
570 decode_status (status
, &symbol
, &code
, &coredump
);
572 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
575 synchronize_system_messages_locale ();
576 signame
= strsignal (code
);
578 string
= build_string ("unknown");
583 string
= build_unibyte_string (signame
);
584 if (! NILP (Vlocale_coding_system
))
585 string
= (code_convert_string_norecord
586 (string
, Vlocale_coding_system
, 0));
587 c1
= STRING_CHAR (SDATA (string
));
590 Faset (string
, make_number (0), make_number (c2
));
592 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
593 return concat2 (string
, string2
);
595 else if (EQ (symbol
, Qexit
))
598 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
600 return build_string ("finished\n");
601 string
= Fnumber_to_string (make_number (code
));
602 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
603 return concat3 (build_string ("exited abnormally with code "),
606 else if (EQ (symbol
, Qfailed
))
608 string
= Fnumber_to_string (make_number (code
));
609 string2
= build_string ("\n");
610 return concat3 (build_string ("failed with code "),
614 return Fcopy_sequence (Fsymbol_name (symbol
));
619 /* The file name of the pty opened by allocate_pty. */
620 static char pty_name
[24];
622 /* Open an available pty, returning a file descriptor.
623 Return -1 on failure.
624 The file name of the terminal corresponding to the pty
625 is left in the variable pty_name. */
636 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
637 for (i
= 0; i
< 16; i
++)
640 #ifdef PTY_NAME_SPRINTF
643 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
644 #endif /* no PTY_NAME_SPRINTF */
648 #else /* no PTY_OPEN */
650 { /* Some systems name their pseudoterminals so that there are gaps in
651 the usual sequence - for example, on HP9000/S700 systems, there
652 are no pseudoterminals with names ending in 'f'. So we wait for
653 three failures in a row before deciding that we've reached the
655 int failed_count
= 0;
658 if (stat (pty_name
, &stb
) < 0)
661 if (failed_count
>= 3)
668 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
670 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
673 #endif /* no PTY_OPEN */
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
682 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
683 #endif /* no PTY_TTY_NAME_SPRINTF */
684 if (access (pty_name
, 6) != 0)
699 #endif /* HAVE_PTYS */
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
)];
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. */
721 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
724 /* If name is already in use, modify it until it is unused. */
729 tem
= Fget_process (name1
);
730 if (NILP (tem
)) break;
731 name1
= concat2 (name
, make_formatted_string (suffix
, "<%"pMd
">", i
));
735 XSETPROCESS (val
, p
);
736 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
741 remove_process (register Lisp_Object proc
)
743 register Lisp_Object pair
;
745 pair
= Frassq (proc
, Vprocess_alist
);
746 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
748 deactivate_process (proc
);
752 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
753 doc
: /* Return t if OBJECT is a process. */)
756 return PROCESSP (object
) ? Qt
: Qnil
;
759 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
760 doc
: /* Return the process named NAME, or nil if there is none. */)
761 (register Lisp_Object name
)
766 return Fcdr (Fassoc (name
, Vprocess_alist
));
769 /* This is how commands for the user decode process arguments. It
770 accepts a process, a process name, a buffer, a buffer name, or nil.
771 Buffers denote the first process in the buffer, and nil denotes the
775 get_process (register Lisp_Object name
)
777 register Lisp_Object proc
, obj
;
780 obj
= Fget_process (name
);
782 obj
= Fget_buffer (name
);
784 error ("Process %s does not exist", SDATA (name
));
786 else if (NILP (name
))
787 obj
= Fcurrent_buffer ();
791 /* Now obj should be either a buffer object or a process object.
795 proc
= Fget_buffer_process (obj
);
797 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
809 /* Fdelete_process promises to immediately forget about the process, but in
810 reality, Emacs needs to remember those processes until they have been
811 treated by the SIGCHLD handler; otherwise this handler would consider the
812 process as being synchronous and say that the synchronous process is
814 static Lisp_Object deleted_pid_list
;
817 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
818 doc
: /* Delete PROCESS: kill it and forget about it immediately.
819 PROCESS may be a process, a buffer, the name of a process or buffer, or
820 nil, indicating the current buffer's process. */)
821 (register Lisp_Object process
)
823 register struct Lisp_Process
*p
;
825 process
= get_process (process
);
826 p
= XPROCESS (process
);
828 p
->raw_status_new
= 0;
829 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
831 pset_status (p
, Fcons (Qexit
, Fcons (make_number (0), Qnil
)));
832 p
->tick
= ++process_tick
;
834 redisplay_preserve_echo_area (13);
836 else if (p
->infd
>= 0)
842 /* No problem storing the pid here, as it is still in Vprocess_alist. */
843 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
844 /* GC treated elements set to nil. */
845 Fdelq (Qnil
, deleted_pid_list
));
846 /* If the process has already signaled, remove it from the list. */
847 if (p
->raw_status_new
)
850 if (CONSP (p
->status
))
851 symbol
= XCAR (p
->status
);
852 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
854 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
858 Fkill_process (process
, Qnil
);
859 /* Do this now, since remove_process will make the
860 SIGCHLD handler do nothing. */
861 pset_status (p
, Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
)));
862 p
->tick
= ++process_tick
;
864 redisplay_preserve_echo_area (13);
867 remove_process (process
);
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
);
894 process
= get_process (process
);
899 p
= XPROCESS (process
);
900 if (p
->raw_status_new
)
904 status
= XCAR (status
);
905 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
907 if (EQ (status
, Qexit
))
909 else if (EQ (p
->command
, Qt
))
911 else if (EQ (status
, Qrun
))
917 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
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
)
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
,
978 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
980 (register Lisp_Object process
, Lisp_Object buffer
)
982 struct Lisp_Process
*p
;
984 CHECK_PROCESS (process
);
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
);
995 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
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
,
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
,
1016 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
1017 A value of t means stop accepting output from the process.
1019 When a process has a 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 ...))
1043 (set-process-filter process ...) */
1047 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1049 FD_CLR (p
->infd
, &input_wait_mask
);
1050 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1052 else if (EQ (p
->filter
, Qt
)
1053 /* Network or serial process not stopped: */
1054 && !EQ (p
->command
, Qt
))
1056 FD_SET (p
->infd
, &input_wait_mask
);
1057 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1061 pset_filter (p
, filter
);
1062 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1063 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1064 setup_process_coding_systems (process
);
1068 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1070 doc
: /* Returns the filter function of PROCESS; nil if none.
1071 See `set-process-filter' for more info on filter functions. */)
1072 (register Lisp_Object process
)
1074 CHECK_PROCESS (process
);
1075 return XPROCESS (process
)->filter
;
1078 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1080 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1081 The sentinel is called as a function when the process changes state.
1082 It gets two arguments: the process, and a string describing the change. */)
1083 (register Lisp_Object process
, Lisp_Object sentinel
)
1085 struct Lisp_Process
*p
;
1087 CHECK_PROCESS (process
);
1088 p
= XPROCESS (process
);
1090 pset_sentinel (p
, sentinel
);
1091 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1092 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1096 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1098 doc
: /* Return the sentinel of PROCESS; nil if none.
1099 See `set-process-sentinel' for more info on sentinels. */)
1100 (register Lisp_Object process
)
1102 CHECK_PROCESS (process
);
1103 return XPROCESS (process
)->sentinel
;
1106 DEFUN ("set-process-window-size", Fset_process_window_size
,
1107 Sset_process_window_size
, 3, 3, 0,
1108 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1109 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1111 CHECK_PROCESS (process
);
1112 CHECK_RANGED_INTEGER (height
, 0, INT_MAX
);
1113 CHECK_RANGED_INTEGER (width
, 0, INT_MAX
);
1115 if (XPROCESS (process
)->infd
< 0
1116 || set_window_size (XPROCESS (process
)->infd
,
1117 XINT (height
), XINT (width
)) <= 0)
1123 DEFUN ("set-process-inherit-coding-system-flag",
1124 Fset_process_inherit_coding_system_flag
,
1125 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1126 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1127 If the second argument FLAG is non-nil, then the variable
1128 `buffer-file-coding-system' of the buffer associated with PROCESS
1129 will be bound to the value of the coding system used to decode
1132 This is useful when the coding system specified for the process buffer
1133 leaves either the character code conversion or the end-of-line conversion
1134 unspecified, or if the coding system used to decode the process output
1135 is more appropriate for saving the process buffer.
1137 Binding the variable `inherit-process-coding-system' to non-nil before
1138 starting the process is an alternative way of setting the inherit flag
1139 for the process which will run.
1141 This function returns FLAG. */)
1142 (register Lisp_Object process
, Lisp_Object flag
)
1144 CHECK_PROCESS (process
);
1145 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1149 DEFUN ("set-process-query-on-exit-flag",
1150 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1152 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1153 If the second argument FLAG is non-nil, Emacs will query the user before
1154 exiting or killing a buffer if PROCESS is running. This function
1156 (register Lisp_Object process
, Lisp_Object flag
)
1158 CHECK_PROCESS (process
);
1159 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1163 DEFUN ("process-query-on-exit-flag",
1164 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1166 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1167 (register Lisp_Object process
)
1169 CHECK_PROCESS (process
);
1170 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1173 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1175 doc
: /* Return the contact info of PROCESS; t for a real child.
1176 For a network or serial connection, the value depends on the optional
1177 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1178 SERVICE) for a network connection or (PORT SPEED) for a serial
1179 connection. If KEY is t, the complete contact information for the
1180 connection is returned, else the specific value for the keyword KEY is
1181 returned. See `make-network-process' or `make-serial-process' for a
1182 list of keywords. */)
1183 (register Lisp_Object process
, Lisp_Object key
)
1185 Lisp_Object contact
;
1187 CHECK_PROCESS (process
);
1188 contact
= XPROCESS (process
)->childp
;
1190 #ifdef DATAGRAM_SOCKETS
1191 if (DATAGRAM_CONN_P (process
)
1192 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1193 contact
= Fplist_put (contact
, QCremote
,
1194 Fprocess_datagram_address (process
));
1197 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1199 if (NILP (key
) && NETCONN_P (process
))
1200 return Fcons (Fplist_get (contact
, QChost
),
1201 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1202 if (NILP (key
) && SERIALCONN_P (process
))
1203 return Fcons (Fplist_get (contact
, QCport
),
1204 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1205 return Fplist_get (contact
, key
);
1208 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1210 doc
: /* Return the plist of PROCESS. */)
1211 (register Lisp_Object process
)
1213 CHECK_PROCESS (process
);
1214 return XPROCESS (process
)->plist
;
1217 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1219 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1220 (register Lisp_Object process
, Lisp_Object plist
)
1222 CHECK_PROCESS (process
);
1225 pset_plist (XPROCESS (process
), plist
);
1229 #if 0 /* Turned off because we don't currently record this info
1230 in the process. Perhaps add it. */
1231 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1232 doc
: /* Return the connection type of PROCESS.
1233 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1234 a socket connection. */)
1235 (Lisp_Object process
)
1237 return XPROCESS (process
)->type
;
1241 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1242 doc
: /* Return the connection type of PROCESS.
1243 The value is either the symbol `real', `network', or `serial'.
1244 PROCESS may be a process, a buffer, the name of a process or buffer, or
1245 nil, indicating the current buffer's process. */)
1246 (Lisp_Object process
)
1249 proc
= get_process (process
);
1250 return XPROCESS (proc
)->type
;
1253 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1255 doc
: /* Convert network ADDRESS from internal format to a string.
1256 A 4 or 5 element vector represents an IPv4 address (with port number).
1257 An 8 or 9 element vector represents an IPv6 address (with port number).
1258 If optional second argument OMIT-PORT is non-nil, don't include a port
1259 number in the string, even when present in ADDRESS.
1260 Returns nil if format of ADDRESS is invalid. */)
1261 (Lisp_Object address
, Lisp_Object omit_port
)
1266 if (STRINGP (address
)) /* AF_LOCAL */
1269 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1271 register struct Lisp_Vector
*p
= XVECTOR (address
);
1272 ptrdiff_t size
= p
->header
.size
;
1273 Lisp_Object args
[10];
1276 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1278 args
[0] = build_string ("%d.%d.%d.%d");
1283 args
[0] = build_string ("%d.%d.%d.%d:%d");
1286 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1288 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1293 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1299 for (i
= 0; i
< nargs
; i
++)
1301 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1304 if (nargs
<= 5 /* IPv4 */
1305 && i
< 4 /* host, not port */
1306 && XINT (p
->contents
[i
]) > 255)
1309 args
[i
+1] = p
->contents
[i
];
1312 return Fformat (nargs
+1, args
);
1315 if (CONSP (address
))
1317 Lisp_Object args
[2];
1318 args
[0] = build_string ("<Family %d>");
1319 args
[1] = Fcar (address
);
1320 return Fformat (2, args
);
1326 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1327 doc
: /* Return a list of all processes. */)
1330 return Fmapcar (Qcdr
, Vprocess_alist
);
1333 /* Starting asynchronous inferior processes. */
1335 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1337 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1338 doc
: /* Start a program in a subprocess. Return the process object for it.
1339 NAME is name for process. It is modified if necessary to make it unique.
1340 BUFFER is the buffer (or buffer name) to associate with the process.
1342 Process output (both standard output and standard error streams) goes
1343 at end of BUFFER, unless you specify an output stream or filter
1344 function to handle the output. BUFFER may also be nil, meaning that
1345 this process is not associated with any buffer.
1347 PROGRAM is the program file name. It is searched for in `exec-path'
1348 (which see). If nil, just associate a pty with the buffer. Remaining
1349 arguments are strings to give program as arguments.
1351 If you want to separate standard output from standard error, invoke
1352 the command through a shell and redirect one of them using the shell
1355 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1356 (ptrdiff_t nargs
, Lisp_Object
*args
)
1358 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1359 register unsigned char **new_argv
;
1361 ptrdiff_t count
= SPECPDL_INDEX ();
1365 buffer
= Fget_buffer_create (buffer
);
1367 /* Make sure that the child will be able to chdir to the current
1368 buffer's current directory, or its unhandled equivalent. We
1369 can't just have the child check for an error when it does the
1370 chdir, since it's in a vfork.
1372 We have to GCPRO around this because Fexpand_file_name and
1373 Funhandled_file_name_directory might call a file name handling
1374 function. The argument list is protected by the caller, so all
1375 we really have to worry about is buffer. */
1377 struct gcpro gcpro1
, gcpro2
;
1379 current_dir
= BVAR (current_buffer
, directory
);
1381 GCPRO2 (buffer
, current_dir
);
1383 current_dir
= Funhandled_file_name_directory (current_dir
);
1384 if (NILP (current_dir
))
1385 /* If the file name handler says that current_dir is unreachable, use
1386 a sensible default. */
1387 current_dir
= build_string ("~/");
1388 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1389 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1390 report_file_error ("Setting current directory",
1391 Fcons (BVAR (current_buffer
, directory
), Qnil
));
1397 CHECK_STRING (name
);
1401 if (!NILP (program
))
1402 CHECK_STRING (program
);
1404 proc
= make_process (name
);
1405 /* If an error occurs and we can't start the process, we want to
1406 remove it from the process list. This means that each error
1407 check in create_process doesn't need to call remove_process
1408 itself; it's all taken care of here. */
1409 record_unwind_protect (start_process_unwind
, proc
);
1411 pset_childp (XPROCESS (proc
), Qt
);
1412 pset_plist (XPROCESS (proc
), Qnil
);
1413 pset_type (XPROCESS (proc
), Qreal
);
1414 pset_buffer (XPROCESS (proc
), buffer
);
1415 pset_sentinel (XPROCESS (proc
), Qnil
);
1416 pset_filter (XPROCESS (proc
), Qnil
);
1417 pset_command (XPROCESS (proc
), Flist (nargs
- 2, args
+ 2));
1420 /* AKA GNUTLS_INITSTAGE(proc). */
1421 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1422 pset_gnutls_cred_type (XPROCESS (proc
), Qnil
);
1425 #ifdef ADAPTIVE_READ_BUFFERING
1426 XPROCESS (proc
)->adaptive_read_buffering
1427 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1428 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1431 /* Make the process marker point into the process buffer (if any). */
1432 if (BUFFERP (buffer
))
1433 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1434 BUF_ZV (XBUFFER (buffer
)),
1435 BUF_ZV_BYTE (XBUFFER (buffer
)));
1438 /* Decide coding systems for communicating with the process. Here
1439 we don't setup the structure coding_system nor pay attention to
1440 unibyte mode. They are done in create_process. */
1442 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1443 Lisp_Object coding_systems
= Qt
;
1444 Lisp_Object val
, *args2
;
1445 struct gcpro gcpro1
, gcpro2
;
1447 val
= Vcoding_system_for_read
;
1450 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1451 args2
[0] = Qstart_process
;
1452 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1453 GCPRO2 (proc
, current_dir
);
1454 if (!NILP (program
))
1455 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1457 if (CONSP (coding_systems
))
1458 val
= XCAR (coding_systems
);
1459 else if (CONSP (Vdefault_process_coding_system
))
1460 val
= XCAR (Vdefault_process_coding_system
);
1462 pset_decode_coding_system (XPROCESS (proc
), val
);
1464 val
= Vcoding_system_for_write
;
1467 if (EQ (coding_systems
, Qt
))
1469 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1470 args2
[0] = Qstart_process
;
1471 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1472 GCPRO2 (proc
, current_dir
);
1473 if (!NILP (program
))
1474 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1477 if (CONSP (coding_systems
))
1478 val
= XCDR (coding_systems
);
1479 else if (CONSP (Vdefault_process_coding_system
))
1480 val
= XCDR (Vdefault_process_coding_system
);
1482 pset_encode_coding_system (XPROCESS (proc
), val
);
1483 /* Note: At this moment, the above coding system may leave
1484 text-conversion or eol-conversion unspecified. They will be
1485 decided after we read output from the process and decode it by
1486 some coding system, or just before we actually send a text to
1491 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1492 XPROCESS (proc
)->decoding_carryover
= 0;
1493 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1495 XPROCESS (proc
)->inherit_coding_system_flag
1496 = !(NILP (buffer
) || !inherit_process_coding_system
);
1498 if (!NILP (program
))
1500 /* If program file name is not absolute, search our path for it.
1501 Put the name we will really use in TEM. */
1502 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1503 && !(SCHARS (program
) > 1
1504 && IS_DEVICE_SEP (SREF (program
, 1))))
1506 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1509 GCPRO4 (name
, program
, buffer
, current_dir
);
1510 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1513 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1514 tem
= Fexpand_file_name (tem
, Qnil
);
1518 if (!NILP (Ffile_directory_p (program
)))
1519 error ("Specified program for new process is a directory");
1523 /* If program file name starts with /: for quoting a magic name,
1525 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1526 && SREF (tem
, 1) == ':')
1527 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1530 Lisp_Object arg_encoding
= Qnil
;
1531 struct gcpro gcpro1
;
1534 /* Encode the file name and put it in NEW_ARGV.
1535 That's where the child will use it to execute the program. */
1536 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1538 /* Here we encode arguments by the coding system used for sending
1539 data to the process. We don't support using different coding
1540 systems for encoding arguments and for encoding data sent to the
1543 for (i
= 3; i
< nargs
; i
++)
1545 tem
= Fcons (args
[i
], tem
);
1546 CHECK_STRING (XCAR (tem
));
1547 if (STRING_MULTIBYTE (XCAR (tem
)))
1549 if (NILP (arg_encoding
))
1550 arg_encoding
= (complement_process_encoding_system
1551 (XPROCESS (proc
)->encode_coding_system
));
1553 code_convert_string_norecord
1554 (XCAR (tem
), arg_encoding
, 1));
1561 /* Now that everything is encoded we can collect the strings into
1563 new_argv
= alloca ((nargs
- 1) * sizeof *new_argv
);
1564 new_argv
[nargs
- 2] = 0;
1566 for (i
= nargs
- 2; i
-- != 0; )
1568 new_argv
[i
] = SDATA (XCAR (tem
));
1572 create_process (proc
, (char **) new_argv
, current_dir
);
1577 return unbind_to (count
, proc
);
1580 /* This function is the unwind_protect form for Fstart_process. If
1581 PROC doesn't have its pid set, then we know someone has signaled
1582 an error and the process wasn't started successfully, so we should
1583 remove it from the process list. */
1585 start_process_unwind (Lisp_Object proc
)
1587 if (!PROCESSP (proc
))
1590 /* Was PROC started successfully?
1591 -2 is used for a pty with no process, eg for gdb. */
1592 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1593 remove_process (proc
);
1599 create_process_1 (struct atimer
*timer
)
1601 /* Nothing to do. */
1606 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1608 int inchannel
, outchannel
;
1611 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1612 int wait_child_setup
[2];
1614 sigset_t blocked
, procmask
;
1615 struct sigaction sigint_action
;
1616 struct sigaction sigquit_action
;
1617 struct sigaction sigpipe_action
;
1619 struct sigaction sighup_action
;
1621 /* Use volatile to protect variables from being clobbered by longjmp. */
1622 volatile int forkin
, forkout
;
1623 volatile int pty_flag
= 0;
1625 inchannel
= outchannel
= -1;
1628 if (!NILP (Vprocess_connection_type
))
1629 outchannel
= inchannel
= allocate_pty ();
1633 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1634 /* On most USG systems it does not work to open the pty's tty here,
1635 then close it and reopen it in the child. */
1637 /* Don't let this terminal become our controlling terminal
1638 (in case we don't have one). */
1639 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1641 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1644 report_file_error ("Opening pty", Qnil
);
1646 forkin
= forkout
= -1;
1647 #endif /* not USG, or USG_SUBTTY_WORKS */
1651 #endif /* HAVE_PTYS */
1656 report_file_error ("Creating pipe", Qnil
);
1662 emacs_close (inchannel
);
1663 emacs_close (forkout
);
1664 report_file_error ("Creating pipe", Qnil
);
1670 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1674 tem
= pipe (wait_child_setup
);
1676 report_file_error ("Creating pipe", Qnil
);
1677 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1679 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1682 emacs_close (wait_child_setup
[0]);
1683 emacs_close (wait_child_setup
[1]);
1684 report_file_error ("Setting file descriptor flags", Qnil
);
1690 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1691 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1694 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1695 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1699 /* Record this as an active process, with its channels.
1700 As a result, child_setup will close Emacs's side of the pipes. */
1701 chan_process
[inchannel
] = process
;
1702 XPROCESS (process
)->infd
= inchannel
;
1703 XPROCESS (process
)->outfd
= outchannel
;
1705 /* Previously we recorded the tty descriptor used in the subprocess.
1706 It was only used for getting the foreground tty process, so now
1707 we just reopen the device (see emacs_get_tty_pgrp) as this is
1708 more portable (see USG_SUBTTY_WORKS above). */
1710 XPROCESS (process
)->pty_flag
= pty_flag
;
1711 pset_status (XPROCESS (process
), Qrun
);
1713 /* Delay interrupts until we have a chance to store
1714 the new fork's pid in its process structure */
1715 sigemptyset (&blocked
);
1717 sigaddset (&blocked
, SIGCHLD
);
1719 #ifdef HAVE_WORKING_VFORK
1720 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1721 this sets the parent's signal handlers as well as the child's.
1722 So delay all interrupts whose handlers the child might munge,
1723 and record the current handlers so they can be restored later. */
1724 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1725 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1726 sigaddset (&blocked
, SIGPIPE
); sigaction (SIGPIPE
, 0, &sigpipe_action
);
1728 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1730 #endif /* HAVE_WORKING_VFORK */
1731 pthread_sigmask (SIG_BLOCK
, &blocked
, &procmask
);
1733 FD_SET (inchannel
, &input_wait_mask
);
1734 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1735 if (inchannel
> max_process_desc
)
1736 max_process_desc
= inchannel
;
1738 /* Until we store the proper pid, enable the SIGCHLD handler
1739 to recognize an unknown pid as standing for this process.
1740 It is very important not to let this `marker' value stay
1741 in the table after this function has returned; if it does
1742 it might cause call-process to hang and subsequent asynchronous
1743 processes to get their return values scrambled. */
1744 XPROCESS (process
)->pid
= -1;
1746 /* This must be called after the above line because it may signal an
1748 setup_process_coding_systems (process
);
1753 /* child_setup must clobber environ on systems with true vfork.
1754 Protect it from permanent change. */
1755 char **save_environ
= environ
;
1756 volatile Lisp_Object encoded_current_dir
= ENCODE_FILE (current_dir
);
1761 #endif /* not WINDOWSNT */
1763 int xforkin
= forkin
;
1764 int xforkout
= forkout
;
1766 /* Make the pty be the controlling terminal of the process. */
1768 /* First, disconnect its current controlling terminal. */
1770 /* We tried doing setsid only if pty_flag, but it caused
1771 process_set_signal to fail on SGI when using a pipe. */
1773 /* Make the pty's terminal the controlling terminal. */
1774 if (pty_flag
&& xforkin
>= 0)
1777 /* We ignore the return value
1778 because faith@cs.unc.edu says that is necessary on Linux. */
1779 ioctl (xforkin
, TIOCSCTTY
, 0);
1782 #else /* not HAVE_SETSID */
1784 /* It's very important to call setpgrp here and no time
1785 afterwards. Otherwise, we lose our controlling tty which
1786 is set when we open the pty. */
1789 #endif /* not HAVE_SETSID */
1790 #if defined (LDISC1)
1791 if (pty_flag
&& xforkin
>= 0)
1794 tcgetattr (xforkin
, &t
);
1796 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1797 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1800 #if defined (NTTYDISC) && defined (TIOCSETD)
1801 if (pty_flag
&& xforkin
>= 0)
1803 /* Use new line discipline. */
1804 int ldisc
= NTTYDISC
;
1805 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1810 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1811 can do TIOCSPGRP only to the process's controlling tty. */
1814 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1815 I can't test it since I don't have 4.3. */
1816 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1819 ioctl (j
, TIOCNOTTY
, 0);
1823 /* In order to get a controlling terminal on some versions
1824 of BSD, it is necessary to put the process in pgrp 0
1825 before it opens the terminal. */
1833 #endif /* TIOCNOTTY */
1835 #if !defined (DONT_REOPEN_PTY)
1836 /*** There is a suggestion that this ought to be a
1837 conditional on TIOCSPGRP,
1838 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1839 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1840 that system does seem to need this code, even though
1841 both HAVE_SETSID and TIOCSCTTY are defined. */
1842 /* Now close the pty (if we had it open) and reopen it.
1843 This makes the pty the controlling terminal of the subprocess. */
1847 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1850 emacs_close (xforkin
);
1851 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1855 emacs_write (1, "Couldn't open the pty terminal ", 31);
1856 emacs_write (1, pty_name
, strlen (pty_name
));
1857 emacs_write (1, "\n", 1);
1862 #endif /* not DONT_REOPEN_PTY */
1864 #ifdef SETUP_SLAVE_PTY
1869 #endif /* SETUP_SLAVE_PTY */
1871 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1872 Now reenable it in the child, so it will die when we want it to. */
1874 signal (SIGHUP
, SIG_DFL
);
1876 #endif /* HAVE_PTYS */
1878 signal (SIGINT
, SIG_DFL
);
1879 signal (SIGQUIT
, SIG_DFL
);
1880 /* GConf causes us to ignore SIGPIPE, make sure it is restored
1882 signal (SIGPIPE
, SIG_DFL
);
1884 /* Stop blocking signals in the child. */
1885 pthread_sigmask (SIG_SETMASK
, &procmask
, 0);
1888 child_setup_tty (xforkout
);
1890 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1891 new_argv
, 1, encoded_current_dir
);
1892 #else /* not WINDOWSNT */
1894 emacs_close (wait_child_setup
[0]);
1896 child_setup (xforkin
, xforkout
, xforkout
,
1897 new_argv
, 1, encoded_current_dir
);
1898 #endif /* not WINDOWSNT */
1900 environ
= save_environ
;
1905 /* This runs in the Emacs process. */
1909 emacs_close (forkin
);
1910 if (forkin
!= forkout
&& forkout
>= 0)
1911 emacs_close (forkout
);
1915 /* vfork succeeded. */
1916 XPROCESS (process
)->pid
= pid
;
1919 register_child (pid
, inchannel
);
1920 #endif /* WINDOWSNT */
1922 /* If the subfork execv fails, and it exits,
1923 this close hangs. I don't know why.
1924 So have an interrupt jar it loose. */
1926 struct atimer
*timer
;
1927 EMACS_TIME offset
= make_emacs_time (1, 0);
1930 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1933 emacs_close (forkin
);
1935 cancel_atimer (timer
);
1939 if (forkin
!= forkout
&& forkout
>= 0)
1940 emacs_close (forkout
);
1944 pset_tty_name (XPROCESS (process
), build_string (pty_name
));
1947 pset_tty_name (XPROCESS (process
), Qnil
);
1949 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1950 /* Wait for child_setup to complete in case that vfork is
1951 actually defined as fork. The descriptor wait_child_setup[1]
1952 of a pipe is closed at the child side either by close-on-exec
1953 on successful execvp or the _exit call in child_setup. */
1957 emacs_close (wait_child_setup
[1]);
1958 emacs_read (wait_child_setup
[0], &dummy
, 1);
1959 emacs_close (wait_child_setup
[0]);
1964 /* Restore the signal state whether vfork succeeded or not.
1965 (We will signal an error, below, if it failed.) */
1966 #ifdef HAVE_WORKING_VFORK
1967 /* Restore the parent's signal handlers. */
1968 sigaction (SIGINT
, &sigint_action
, 0);
1969 sigaction (SIGQUIT
, &sigquit_action
, 0);
1970 sigaction (SIGPIPE
, &sigpipe_action
, 0);
1972 sigaction (SIGHUP
, &sighup_action
, 0);
1974 #endif /* HAVE_WORKING_VFORK */
1975 /* Stop blocking signals in the parent. */
1976 pthread_sigmask (SIG_SETMASK
, &procmask
, 0);
1978 /* Now generate the error if vfork failed. */
1980 report_file_error ("Doing vfork", Qnil
);
1984 create_pty (Lisp_Object process
)
1986 int inchannel
, outchannel
;
1989 inchannel
= outchannel
= -1;
1992 if (!NILP (Vprocess_connection_type
))
1993 outchannel
= inchannel
= allocate_pty ();
1997 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1998 /* On most USG systems it does not work to open the pty's tty here,
1999 then close it and reopen it in the child. */
2001 /* Don't let this terminal become our controlling terminal
2002 (in case we don't have one). */
2003 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2005 int forkout
= emacs_open (pty_name
, O_RDWR
, 0);
2008 report_file_error ("Opening pty", Qnil
);
2009 #if defined (DONT_REOPEN_PTY)
2010 /* In the case that vfork is defined as fork, the parent process
2011 (Emacs) may send some data before the child process completes
2012 tty options setup. So we setup tty before forking. */
2013 child_setup_tty (forkout
);
2014 #endif /* DONT_REOPEN_PTY */
2015 #endif /* not USG, or USG_SUBTTY_WORKS */
2018 #endif /* HAVE_PTYS */
2021 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2022 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2025 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
2026 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
2030 /* Record this as an active process, with its channels.
2031 As a result, child_setup will close Emacs's side of the pipes. */
2032 chan_process
[inchannel
] = process
;
2033 XPROCESS (process
)->infd
= inchannel
;
2034 XPROCESS (process
)->outfd
= outchannel
;
2036 /* Previously we recorded the tty descriptor used in the subprocess.
2037 It was only used for getting the foreground tty process, so now
2038 we just reopen the device (see emacs_get_tty_pgrp) as this is
2039 more portable (see USG_SUBTTY_WORKS above). */
2041 XPROCESS (process
)->pty_flag
= pty_flag
;
2042 pset_status (XPROCESS (process
), Qrun
);
2043 setup_process_coding_systems (process
);
2045 FD_SET (inchannel
, &input_wait_mask
);
2046 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2047 if (inchannel
> max_process_desc
)
2048 max_process_desc
= inchannel
;
2050 XPROCESS (process
)->pid
= -2;
2053 pset_tty_name (XPROCESS (process
), build_string (pty_name
));
2056 pset_tty_name (XPROCESS (process
), Qnil
);
2060 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2061 The address family of sa is not included in the result. */
2064 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2066 Lisp_Object address
;
2069 register struct Lisp_Vector
*p
;
2071 /* Workaround for a bug in getsockname on BSD: Names bound to
2072 sockets in the UNIX domain are inaccessible; getsockname returns
2073 a zero length name. */
2074 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2075 return empty_unibyte_string
;
2077 switch (sa
->sa_family
)
2081 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2082 len
= sizeof (sin
->sin_addr
) + 1;
2083 address
= Fmake_vector (make_number (len
), Qnil
);
2084 p
= XVECTOR (address
);
2085 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2086 cp
= (unsigned char *) &sin
->sin_addr
;
2092 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2093 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2094 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2095 address
= Fmake_vector (make_number (len
), Qnil
);
2096 p
= XVECTOR (address
);
2097 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2098 for (i
= 0; i
< len
; i
++)
2099 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2103 #ifdef HAVE_LOCAL_SOCKETS
2106 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2107 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2108 if (sockun
->sun_path
[i
] == 0)
2110 return make_unibyte_string (sockun
->sun_path
, i
);
2114 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2115 address
= Fcons (make_number (sa
->sa_family
),
2116 Fmake_vector (make_number (len
), Qnil
));
2117 p
= XVECTOR (XCDR (address
));
2118 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2124 p
->contents
[i
++] = make_number (*cp
++);
2130 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2133 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2135 register struct Lisp_Vector
*p
;
2137 if (VECTORP (address
))
2139 p
= XVECTOR (address
);
2140 if (p
->header
.size
== 5)
2143 return sizeof (struct sockaddr_in
);
2146 else if (p
->header
.size
== 9)
2148 *familyp
= AF_INET6
;
2149 return sizeof (struct sockaddr_in6
);
2153 #ifdef HAVE_LOCAL_SOCKETS
2154 else if (STRINGP (address
))
2156 *familyp
= AF_LOCAL
;
2157 return sizeof (struct sockaddr_un
);
2160 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2161 && VECTORP (XCDR (address
)))
2163 struct sockaddr
*sa
;
2164 *familyp
= XINT (XCAR (address
));
2165 p
= XVECTOR (XCDR (address
));
2166 return p
->header
.size
+ sizeof (sa
->sa_family
);
2171 /* Convert an address object (vector or string) to an internal sockaddr.
2173 The address format has been basically validated by
2174 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2175 it could have come from user data. So if FAMILY is not valid,
2176 we return after zeroing *SA. */
2179 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2181 register struct Lisp_Vector
*p
;
2182 register unsigned char *cp
= NULL
;
2186 memset (sa
, 0, len
);
2188 if (VECTORP (address
))
2190 p
= XVECTOR (address
);
2191 if (family
== AF_INET
)
2193 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2194 len
= sizeof (sin
->sin_addr
) + 1;
2195 hostport
= XINT (p
->contents
[--len
]);
2196 sin
->sin_port
= htons (hostport
);
2197 cp
= (unsigned char *)&sin
->sin_addr
;
2198 sa
->sa_family
= family
;
2201 else if (family
== AF_INET6
)
2203 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2204 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2205 len
= sizeof (sin6
->sin6_addr
) + 1;
2206 hostport
= XINT (p
->contents
[--len
]);
2207 sin6
->sin6_port
= htons (hostport
);
2208 for (i
= 0; i
< len
; i
++)
2209 if (INTEGERP (p
->contents
[i
]))
2211 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2214 sa
->sa_family
= family
;
2221 else if (STRINGP (address
))
2223 #ifdef HAVE_LOCAL_SOCKETS
2224 if (family
== AF_LOCAL
)
2226 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2227 cp
= SDATA (address
);
2228 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2229 sockun
->sun_path
[i
] = *cp
++;
2230 sa
->sa_family
= family
;
2237 p
= XVECTOR (XCDR (address
));
2238 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2241 for (i
= 0; i
< len
; i
++)
2242 if (INTEGERP (p
->contents
[i
]))
2243 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2246 #ifdef DATAGRAM_SOCKETS
2247 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2249 doc
: /* Get the current datagram address associated with PROCESS. */)
2250 (Lisp_Object process
)
2254 CHECK_PROCESS (process
);
2256 if (!DATAGRAM_CONN_P (process
))
2259 channel
= XPROCESS (process
)->infd
;
2260 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2261 datagram_address
[channel
].len
);
2264 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2266 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2267 Returns nil upon error setting address, ADDRESS otherwise. */)
2268 (Lisp_Object process
, Lisp_Object address
)
2273 CHECK_PROCESS (process
);
2275 if (!DATAGRAM_CONN_P (process
))
2278 channel
= XPROCESS (process
)->infd
;
2280 len
= get_lisp_to_sockaddr_size (address
, &family
);
2281 if (datagram_address
[channel
].len
!= len
)
2283 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2289 static const struct socket_options
{
2290 /* The name of this option. Should be lowercase version of option
2291 name without SO_ prefix. */
2293 /* Option level SOL_... */
2295 /* Option number SO_... */
2297 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2298 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2299 } socket_options
[] =
2301 #ifdef SO_BINDTODEVICE
2302 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2305 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2308 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2311 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2314 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2317 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2320 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2323 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2325 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2328 /* Set option OPT to value VAL on socket S.
2330 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2331 Signals an error if setting a known option fails.
2335 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2338 const struct socket_options
*sopt
;
2343 name
= SSDATA (SYMBOL_NAME (opt
));
2344 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2345 if (strcmp (name
, sopt
->name
) == 0)
2348 switch (sopt
->opttype
)
2353 optval
= NILP (val
) ? 0 : 1;
2354 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2355 &optval
, sizeof (optval
));
2362 if (TYPE_RANGED_INTEGERP (int, val
))
2363 optval
= XINT (val
);
2365 error ("Bad option value for %s", name
);
2366 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2367 &optval
, sizeof (optval
));
2371 #ifdef SO_BINDTODEVICE
2374 char devname
[IFNAMSIZ
+1];
2376 /* This is broken, at least in the Linux 2.4 kernel.
2377 To unbind, the arg must be a zero integer, not the empty string.
2378 This should work on all systems. KFS. 2003-09-23. */
2379 memset (devname
, 0, sizeof devname
);
2382 char *arg
= SSDATA (val
);
2383 int len
= min (strlen (arg
), IFNAMSIZ
);
2384 memcpy (devname
, arg
, len
);
2386 else if (!NILP (val
))
2387 error ("Bad option value for %s", name
);
2388 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2397 struct linger linger
;
2400 linger
.l_linger
= 0;
2401 if (TYPE_RANGED_INTEGERP (int, val
))
2402 linger
.l_linger
= XINT (val
);
2404 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2405 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2406 &linger
, sizeof (linger
));
2416 report_file_error ("Cannot set network option",
2417 Fcons (opt
, Fcons (val
, Qnil
)));
2418 return (1 << sopt
->optbit
);
2422 DEFUN ("set-network-process-option",
2423 Fset_network_process_option
, Sset_network_process_option
,
2425 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2426 See `make-network-process' for a list of options and values.
2427 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2428 OPTION is not a supported option, return nil instead; otherwise return t. */)
2429 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2432 struct Lisp_Process
*p
;
2434 CHECK_PROCESS (process
);
2435 p
= XPROCESS (process
);
2436 if (!NETCONN1_P (p
))
2437 error ("Process is not a network process");
2441 error ("Process is not running");
2443 if (set_socket_option (s
, option
, value
))
2445 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2449 if (NILP (no_error
))
2450 error ("Unknown or unsupported option");
2456 DEFUN ("serial-process-configure",
2457 Fserial_process_configure
,
2458 Sserial_process_configure
,
2460 doc
: /* Configure speed, bytesize, etc. of a serial process.
2462 Arguments are specified as keyword/argument pairs. Attributes that
2463 are not given are re-initialized from the process's current
2464 configuration (available via the function `process-contact') or set to
2465 reasonable default values. The following arguments are defined:
2471 -- Any of these arguments can be given to identify the process that is
2472 to be configured. If none of these arguments is given, the current
2473 buffer's process is used.
2475 :speed SPEED -- SPEED is the speed of the serial port in bits per
2476 second, also called baud rate. Any value can be given for SPEED, but
2477 most serial ports work only at a few defined values between 1200 and
2478 115200, with 9600 being the most common value. If SPEED is nil, the
2479 serial port is not configured any further, i.e., all other arguments
2480 are ignored. This may be useful for special serial ports such as
2481 Bluetooth-to-serial converters which can only be configured through AT
2482 commands. A value of nil for SPEED can be used only when passed
2483 through `make-serial-process' or `serial-term'.
2485 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2486 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2488 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2489 `odd' (use odd parity), or the symbol `even' (use even parity). If
2490 PARITY is not given, no parity is used.
2492 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2493 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2494 is not given or nil, 1 stopbit is used.
2496 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2497 flowcontrol to be used, which is either nil (don't use flowcontrol),
2498 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2499 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2500 flowcontrol is used.
2502 `serial-process-configure' is called by `make-serial-process' for the
2503 initial configuration of the serial port.
2507 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2509 \(serial-process-configure
2510 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2512 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2514 usage: (serial-process-configure &rest ARGS) */)
2515 (ptrdiff_t nargs
, Lisp_Object
*args
)
2517 struct Lisp_Process
*p
;
2518 Lisp_Object contact
= Qnil
;
2519 Lisp_Object proc
= Qnil
;
2520 struct gcpro gcpro1
;
2522 contact
= Flist (nargs
, args
);
2525 proc
= Fplist_get (contact
, QCprocess
);
2527 proc
= Fplist_get (contact
, QCname
);
2529 proc
= Fplist_get (contact
, QCbuffer
);
2531 proc
= Fplist_get (contact
, QCport
);
2532 proc
= get_process (proc
);
2533 p
= XPROCESS (proc
);
2534 if (!EQ (p
->type
, Qserial
))
2535 error ("Not a serial process");
2537 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2543 serial_configure (p
, contact
);
2549 /* Used by make-serial-process to recover from errors. */
2551 make_serial_process_unwind (Lisp_Object proc
)
2553 if (!PROCESSP (proc
))
2555 remove_process (proc
);
2559 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2561 doc
: /* Create and return a serial port process.
2563 In Emacs, serial port connections are represented by process objects,
2564 so input and output work as for subprocesses, and `delete-process'
2565 closes a serial port connection. However, a serial process has no
2566 process id, it cannot be signaled, and the status codes are different
2567 from normal processes.
2569 `make-serial-process' creates a process and a buffer, on which you
2570 probably want to use `process-send-string'. Try \\[serial-term] for
2571 an interactive terminal. See below for examples.
2573 Arguments are specified as keyword/argument pairs. The following
2574 arguments are defined:
2576 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2577 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2578 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2579 the backslashes in strings).
2581 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2582 which this function calls.
2584 :name NAME -- NAME is the name of the process. If NAME is not given,
2585 the value of PORT is used.
2587 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2588 with the process. Process output goes at the end of that buffer,
2589 unless you specify an output stream or filter function to handle the
2590 output. If BUFFER is not given, the value of NAME is used.
2592 :coding CODING -- If CODING is a symbol, it specifies the coding
2593 system used for both reading and writing for this process. If CODING
2594 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2595 ENCODING is used for writing.
2597 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2598 the process is running. If BOOL is not given, query before exiting.
2600 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2601 In the stopped state, a serial process does not accept incoming data,
2602 but you can send outgoing data. The stopped state is cleared by
2603 `continue-process' and set by `stop-process'.
2605 :filter FILTER -- Install FILTER as the process filter.
2607 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2609 :plist PLIST -- Install PLIST as the initial plist of the process.
2615 -- This function calls `serial-process-configure' to handle these
2618 The original argument list, possibly modified by later configuration,
2619 is available via the function `process-contact'.
2623 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2625 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2627 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2629 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2631 usage: (make-serial-process &rest ARGS) */)
2632 (ptrdiff_t nargs
, Lisp_Object
*args
)
2635 Lisp_Object proc
, contact
, port
;
2636 struct Lisp_Process
*p
;
2637 struct gcpro gcpro1
;
2638 Lisp_Object name
, buffer
;
2639 Lisp_Object tem
, val
;
2640 ptrdiff_t specpdl_count
= -1;
2645 contact
= Flist (nargs
, args
);
2648 port
= Fplist_get (contact
, QCport
);
2650 error ("No port specified");
2651 CHECK_STRING (port
);
2653 if (NILP (Fplist_member (contact
, QCspeed
)))
2654 error (":speed not specified");
2655 if (!NILP (Fplist_get (contact
, QCspeed
)))
2656 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2658 name
= Fplist_get (contact
, QCname
);
2661 CHECK_STRING (name
);
2662 proc
= make_process (name
);
2663 specpdl_count
= SPECPDL_INDEX ();
2664 record_unwind_protect (make_serial_process_unwind
, proc
);
2665 p
= XPROCESS (proc
);
2667 fd
= serial_open (SSDATA (port
));
2670 if (fd
> max_process_desc
)
2671 max_process_desc
= fd
;
2672 chan_process
[fd
] = proc
;
2674 buffer
= Fplist_get (contact
, QCbuffer
);
2677 buffer
= Fget_buffer_create (buffer
);
2678 pset_buffer (p
, buffer
);
2680 pset_childp (p
, contact
);
2681 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2682 pset_type (p
, Qserial
);
2683 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2684 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2686 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2687 p
->kill_without_query
= 1;
2688 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2689 pset_command (p
, Qt
);
2692 if (!EQ (p
->command
, Qt
))
2694 FD_SET (fd
, &input_wait_mask
);
2695 FD_SET (fd
, &non_keyboard_wait_mask
);
2698 if (BUFFERP (buffer
))
2700 set_marker_both (p
->mark
, buffer
,
2701 BUF_ZV (XBUFFER (buffer
)),
2702 BUF_ZV_BYTE (XBUFFER (buffer
)));
2705 tem
= Fplist_member (contact
, QCcoding
);
2706 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2712 val
= XCAR (XCDR (tem
));
2716 else if (!NILP (Vcoding_system_for_read
))
2717 val
= Vcoding_system_for_read
;
2718 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2719 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2721 pset_decode_coding_system (p
, val
);
2726 val
= XCAR (XCDR (tem
));
2730 else if (!NILP (Vcoding_system_for_write
))
2731 val
= Vcoding_system_for_write
;
2732 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2733 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2735 pset_encode_coding_system (p
, val
);
2737 setup_process_coding_systems (proc
);
2738 pset_decoding_buf (p
, empty_unibyte_string
);
2739 p
->decoding_carryover
= 0;
2740 pset_encoding_buf (p
, empty_unibyte_string
);
2741 p
->inherit_coding_system_flag
2742 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2744 Fserial_process_configure (nargs
, args
);
2746 specpdl_ptr
= specpdl
+ specpdl_count
;
2752 /* Create a network stream/datagram client/server process. Treated
2753 exactly like a normal process when reading and writing. Primary
2754 differences are in status display and process deletion. A network
2755 connection has no PID; you cannot signal it. All you can do is
2756 stop/continue it and deactivate/close it via delete-process */
2758 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2760 doc
: /* Create and return a network server or client process.
2762 In Emacs, network connections are represented by process objects, so
2763 input and output work as for subprocesses and `delete-process' closes
2764 a network connection. However, a network process has no process id,
2765 it cannot be signaled, and the status codes are different from normal
2768 Arguments are specified as keyword/argument pairs. The following
2769 arguments are defined:
2771 :name NAME -- NAME is name for process. It is modified if necessary
2774 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2775 with the process. Process output goes at end of that buffer, unless
2776 you specify an output stream or filter function to handle the output.
2777 BUFFER may be also nil, meaning that this process is not associated
2780 :host HOST -- HOST is name of the host to connect to, or its IP
2781 address. The symbol `local' specifies the local host. If specified
2782 for a server process, it must be a valid name or address for the local
2783 host, and only clients connecting to that address will be accepted.
2785 :service SERVICE -- SERVICE is name of the service desired, or an
2786 integer specifying a port number to connect to. If SERVICE is t,
2787 a random port number is selected for the server. (If Emacs was
2788 compiled with getaddrinfo, a port number can also be specified as a
2789 string, e.g. "80", as well as an integer. This is not portable.)
2791 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2792 stream type connection, `datagram' creates a datagram type connection,
2793 `seqpacket' creates a reliable datagram connection.
2795 :family FAMILY -- FAMILY is the address (and protocol) family for the
2796 service specified by HOST and SERVICE. The default (nil) is to use
2797 whatever address family (IPv4 or IPv6) that is defined for the host
2798 and port number specified by HOST and SERVICE. Other address families
2800 local -- for a local (i.e. UNIX) address specified by SERVICE.
2801 ipv4 -- use IPv4 address family only.
2802 ipv6 -- use IPv6 address family only.
2804 :local ADDRESS -- ADDRESS is the local address used for the connection.
2805 This parameter is ignored when opening a client process. When specified
2806 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2808 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2809 connection. This parameter is ignored when opening a stream server
2810 process. For a datagram server process, it specifies the initial
2811 setting of the remote datagram address. When specified for a client
2812 process, the FAMILY, HOST, and SERVICE args are ignored.
2814 The format of ADDRESS depends on the address family:
2815 - An IPv4 address is represented as an vector of integers [A B C D P]
2816 corresponding to numeric IP address A.B.C.D and port number P.
2817 - A local address is represented as a string with the address in the
2818 local address space.
2819 - An "unsupported family" address is represented by a cons (F . AV)
2820 where F is the family number and AV is a vector containing the socket
2821 address data with one element per address data byte. Do not rely on
2822 this format in portable code, as it may depend on implementation
2823 defined constants, data sizes, and data structure alignment.
2825 :coding CODING -- If CODING is a symbol, it specifies the coding
2826 system used for both reading and writing for this process. If CODING
2827 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2828 ENCODING is used for writing.
2830 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2831 return without waiting for the connection to complete; instead, the
2832 sentinel function will be called with second arg matching "open" (if
2833 successful) or "failed" when the connect completes. Default is to use
2834 a blocking connect (i.e. wait) for stream type connections.
2836 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2837 running when Emacs is exited.
2839 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2840 In the stopped state, a server process does not accept new
2841 connections, and a client process does not handle incoming traffic.
2842 The stopped state is cleared by `continue-process' and set by
2845 :filter FILTER -- Install FILTER as the process filter.
2847 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2848 process filter are multibyte, otherwise they are unibyte.
2849 If this keyword is not specified, the strings are multibyte if
2850 the default value of `enable-multibyte-characters' is non-nil.
2852 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2854 :log LOG -- Install LOG as the server process log function. This
2855 function is called when the server accepts a network connection from a
2856 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2857 is the server process, CLIENT is the new process for the connection,
2858 and MESSAGE is a string.
2860 :plist PLIST -- Install PLIST as the new process' initial plist.
2862 :server QLEN -- if QLEN is non-nil, create a server process for the
2863 specified FAMILY, SERVICE, and connection type (stream or datagram).
2864 If QLEN is an integer, it is used as the max. length of the server's
2865 pending connection queue (also known as the backlog); the default
2866 queue length is 5. Default is to create a client process.
2868 The following network options can be specified for this connection:
2870 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2871 :dontroute BOOL -- Only send to directly connected hosts.
2872 :keepalive BOOL -- Send keep-alive messages on network stream.
2873 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2874 :oobinline BOOL -- Place out-of-band data in receive data stream.
2875 :priority INT -- Set protocol defined priority for sent packets.
2876 :reuseaddr BOOL -- Allow reusing a recently used local address
2877 (this is allowed by default for a server process).
2878 :bindtodevice NAME -- bind to interface NAME. Using this may require
2879 special privileges on some systems.
2881 Consult the relevant system programmer's manual pages for more
2882 information on using these options.
2885 A server process will listen for and accept connections from clients.
2886 When a client connection is accepted, a new network process is created
2887 for the connection with the following parameters:
2889 - The client's process name is constructed by concatenating the server
2890 process' NAME and a client identification string.
2891 - If the FILTER argument is non-nil, the client process will not get a
2892 separate process buffer; otherwise, the client's process buffer is a newly
2893 created buffer named after the server process' BUFFER name or process
2894 NAME concatenated with the client identification string.
2895 - The connection type and the process filter and sentinel parameters are
2896 inherited from the server process' TYPE, FILTER and SENTINEL.
2897 - The client process' contact info is set according to the client's
2898 addressing information (typically an IP address and a port number).
2899 - The client process' plist is initialized from the server's plist.
2901 Notice that the FILTER and SENTINEL args are never used directly by
2902 the server process. Also, the BUFFER argument is not used directly by
2903 the server process, but via the optional :log function, accepted (and
2904 failed) connections may be logged in the server process' buffer.
2906 The original argument list, modified with the actual connection
2907 information, is available via the `process-contact' function.
2909 usage: (make-network-process &rest ARGS) */)
2910 (ptrdiff_t nargs
, Lisp_Object
*args
)
2913 Lisp_Object contact
;
2914 struct Lisp_Process
*p
;
2915 #ifdef HAVE_GETADDRINFO
2916 struct addrinfo ai
, *res
, *lres
;
2917 struct addrinfo hints
;
2918 const char *portstring
;
2920 #else /* HAVE_GETADDRINFO */
2921 struct _emacs_addrinfo
2927 struct sockaddr
*ai_addr
;
2928 struct _emacs_addrinfo
*ai_next
;
2930 #endif /* HAVE_GETADDRINFO */
2931 struct sockaddr_in address_in
;
2932 #ifdef HAVE_LOCAL_SOCKETS
2933 struct sockaddr_un address_un
;
2938 int s
= -1, outch
, inch
;
2939 struct gcpro gcpro1
;
2940 ptrdiff_t count
= SPECPDL_INDEX ();
2942 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2944 Lisp_Object name
, buffer
, host
, service
, address
;
2945 Lisp_Object filter
, sentinel
;
2946 int is_non_blocking_client
= 0;
2947 int is_server
= 0, backlog
= 5;
2954 /* Save arguments for process-contact and clone-process. */
2955 contact
= Flist (nargs
, args
);
2959 /* Ensure socket support is loaded if available. */
2960 init_winsock (TRUE
);
2963 /* :type TYPE (nil: stream, datagram */
2964 tem
= Fplist_get (contact
, QCtype
);
2966 socktype
= SOCK_STREAM
;
2967 #ifdef DATAGRAM_SOCKETS
2968 else if (EQ (tem
, Qdatagram
))
2969 socktype
= SOCK_DGRAM
;
2971 #ifdef HAVE_SEQPACKET
2972 else if (EQ (tem
, Qseqpacket
))
2973 socktype
= SOCK_SEQPACKET
;
2976 error ("Unsupported connection type");
2979 tem
= Fplist_get (contact
, QCserver
);
2982 /* Don't support network sockets when non-blocking mode is
2983 not available, since a blocked Emacs is not useful. */
2984 #if !defined (O_NONBLOCK) && !defined (O_NDELAY)
2985 error ("Network servers not supported");
2988 if (TYPE_RANGED_INTEGERP (int, tem
))
2989 backlog
= XINT (tem
);
2993 /* Make QCaddress an alias for :local (server) or :remote (client). */
2994 QCaddress
= is_server
? QClocal
: QCremote
;
2997 if (!is_server
&& socktype
!= SOCK_DGRAM
2998 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
3000 #ifndef NON_BLOCKING_CONNECT
3001 error ("Non-blocking connect not supported");
3003 is_non_blocking_client
= 1;
3007 name
= Fplist_get (contact
, QCname
);
3008 buffer
= Fplist_get (contact
, QCbuffer
);
3009 filter
= Fplist_get (contact
, QCfilter
);
3010 sentinel
= Fplist_get (contact
, QCsentinel
);
3012 CHECK_STRING (name
);
3014 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
3015 ai
.ai_socktype
= socktype
;
3020 /* :local ADDRESS or :remote ADDRESS */
3021 address
= Fplist_get (contact
, QCaddress
);
3022 if (!NILP (address
))
3024 host
= service
= Qnil
;
3026 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
3027 error ("Malformed :address");
3028 ai
.ai_family
= family
;
3029 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
3030 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
3034 /* :family FAMILY -- nil (for Inet), local, or integer. */
3035 tem
= Fplist_get (contact
, QCfamily
);
3038 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
3044 #ifdef HAVE_LOCAL_SOCKETS
3045 else if (EQ (tem
, Qlocal
))
3049 else if (EQ (tem
, Qipv6
))
3052 else if (EQ (tem
, Qipv4
))
3054 else if (TYPE_RANGED_INTEGERP (int, tem
))
3055 family
= XINT (tem
);
3057 error ("Unknown address family");
3059 ai
.ai_family
= family
;
3061 /* :service SERVICE -- string, integer (port number), or t (random port). */
3062 service
= Fplist_get (contact
, QCservice
);
3064 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3065 host
= Fplist_get (contact
, QChost
);
3068 if (EQ (host
, Qlocal
))
3069 /* Depending on setup, "localhost" may map to different IPv4 and/or
3070 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
3071 host
= build_string ("127.0.0.1");
3072 CHECK_STRING (host
);
3075 #ifdef HAVE_LOCAL_SOCKETS
3076 if (family
== AF_LOCAL
)
3080 message (":family local ignores the :host \"%s\" property",
3082 contact
= Fplist_put (contact
, QChost
, Qnil
);
3085 CHECK_STRING (service
);
3086 memset (&address_un
, 0, sizeof address_un
);
3087 address_un
.sun_family
= AF_LOCAL
;
3088 if (sizeof address_un
.sun_path
<= SBYTES (service
))
3089 error ("Service name too long");
3090 strcpy (address_un
.sun_path
, SSDATA (service
));
3091 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3092 ai
.ai_addrlen
= sizeof address_un
;
3097 /* Slow down polling to every ten seconds.
3098 Some kernels have a bug which causes retrying connect to fail
3099 after a connect. Polling can interfere with gethostbyname too. */
3100 #ifdef POLL_FOR_INPUT
3101 if (socktype
!= SOCK_DGRAM
)
3103 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3104 bind_polling_period (10);
3108 #ifdef HAVE_GETADDRINFO
3109 /* If we have a host, use getaddrinfo to resolve both host and service.
3110 Otherwise, use getservbyname to lookup the service. */
3114 /* SERVICE can either be a string or int.
3115 Convert to a C string for later use by getaddrinfo. */
3116 if (EQ (service
, Qt
))
3118 else if (INTEGERP (service
))
3120 sprintf (portbuf
, "%"pI
"d", XINT (service
));
3121 portstring
= portbuf
;
3125 CHECK_STRING (service
);
3126 portstring
= SSDATA (service
);
3131 memset (&hints
, 0, sizeof (hints
));
3133 hints
.ai_family
= family
;
3134 hints
.ai_socktype
= socktype
;
3135 hints
.ai_protocol
= 0;
3137 #ifdef HAVE_RES_INIT
3141 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
3143 #ifdef HAVE_GAI_STRERROR
3144 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3146 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3152 #endif /* HAVE_GETADDRINFO */
3154 /* We end up here if getaddrinfo is not defined, or in case no hostname
3155 has been specified (e.g. for a local server process). */
3157 if (EQ (service
, Qt
))
3159 else if (INTEGERP (service
))
3160 port
= htons ((unsigned short) XINT (service
));
3163 struct servent
*svc_info
;
3164 CHECK_STRING (service
);
3165 svc_info
= getservbyname (SSDATA (service
),
3166 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3168 error ("Unknown service: %s", SDATA (service
));
3169 port
= svc_info
->s_port
;
3172 memset (&address_in
, 0, sizeof address_in
);
3173 address_in
.sin_family
= family
;
3174 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3175 address_in
.sin_port
= port
;
3177 #ifndef HAVE_GETADDRINFO
3180 struct hostent
*host_info_ptr
;
3182 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3183 as it may `hang' Emacs for a very long time. */
3187 #ifdef HAVE_RES_INIT
3191 host_info_ptr
= gethostbyname (SDATA (host
));
3196 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3197 host_info_ptr
->h_length
);
3198 family
= host_info_ptr
->h_addrtype
;
3199 address_in
.sin_family
= family
;
3202 /* Attempt to interpret host as numeric inet address */
3204 unsigned long numeric_addr
;
3205 numeric_addr
= inet_addr (SSDATA (host
));
3206 if (numeric_addr
== -1)
3207 error ("Unknown host \"%s\"", SDATA (host
));
3209 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3210 sizeof (address_in
.sin_addr
));
3214 #endif /* not HAVE_GETADDRINFO */
3216 ai
.ai_family
= family
;
3217 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3218 ai
.ai_addrlen
= sizeof address_in
;
3222 /* Do this in case we never enter the for-loop below. */
3223 count1
= SPECPDL_INDEX ();
3226 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3235 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3242 #ifdef DATAGRAM_SOCKETS
3243 if (!is_server
&& socktype
== SOCK_DGRAM
)
3245 #endif /* DATAGRAM_SOCKETS */
3247 #ifdef NON_BLOCKING_CONNECT
3248 if (is_non_blocking_client
)
3251 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3253 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3265 /* Make us close S if quit. */
3266 record_unwind_protect (close_file_unwind
, make_number (s
));
3268 /* Parse network options in the arg list.
3269 We simply ignore anything which isn't a known option (including other keywords).
3270 An error is signaled if setting a known option fails. */
3271 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3272 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3276 /* Configure as a server socket. */
3278 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3279 explicit :reuseaddr key to override this. */
3280 #ifdef HAVE_LOCAL_SOCKETS
3281 if (family
!= AF_LOCAL
)
3283 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3286 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3287 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3290 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3291 report_file_error ("Cannot bind server socket", Qnil
);
3293 #ifdef HAVE_GETSOCKNAME
3294 if (EQ (service
, Qt
))
3296 struct sockaddr_in sa1
;
3297 socklen_t len1
= sizeof (sa1
);
3298 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3300 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3301 service
= make_number (ntohs (sa1
.sin_port
));
3302 contact
= Fplist_put (contact
, QCservice
, service
);
3307 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3308 report_file_error ("Cannot listen on server socket", Qnil
);
3316 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3319 if (ret
== 0 || xerrno
== EISCONN
)
3321 /* The unwind-protect will be discarded afterwards.
3322 Likewise for immediate_quit. */
3326 #ifdef NON_BLOCKING_CONNECT
3328 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3332 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3339 if (xerrno
== EINTR
)
3341 /* Unlike most other syscalls connect() cannot be called
3342 again. (That would return EALREADY.) The proper way to
3343 wait for completion is pselect(). */
3351 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3357 report_file_error ("select failed", Qnil
);
3361 len
= sizeof xerrno
;
3362 eassert (FD_ISSET (s
, &fdset
));
3363 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3364 report_file_error ("getsockopt failed", Qnil
);
3366 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3370 #endif /* !WINDOWSNT */
3374 /* Discard the unwind protect closing S. */
3375 specpdl_ptr
= specpdl
+ count1
;
3380 if (xerrno
== EINTR
)
3387 #ifdef DATAGRAM_SOCKETS
3388 if (socktype
== SOCK_DGRAM
)
3390 if (datagram_address
[s
].sa
)
3392 datagram_address
[s
].sa
= xmalloc (lres
->ai_addrlen
);
3393 datagram_address
[s
].len
= lres
->ai_addrlen
;
3397 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3398 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3401 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3402 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3403 conv_lisp_to_sockaddr (rfamily
, remote
,
3404 datagram_address
[s
].sa
, rlen
);
3408 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3411 contact
= Fplist_put (contact
, QCaddress
,
3412 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3413 #ifdef HAVE_GETSOCKNAME
3416 struct sockaddr_in sa1
;
3417 socklen_t len1
= sizeof (sa1
);
3418 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3419 contact
= Fplist_put (contact
, QClocal
,
3420 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3427 #ifdef HAVE_GETADDRINFO
3436 /* Discard the unwind protect for closing S, if any. */
3437 specpdl_ptr
= specpdl
+ count1
;
3439 /* Unwind bind_polling_period and request_sigio. */
3440 unbind_to (count
, Qnil
);
3444 /* If non-blocking got this far - and failed - assume non-blocking is
3445 not supported after all. This is probably a wrong assumption, but
3446 the normal blocking calls to open-network-stream handles this error
3448 if (is_non_blocking_client
)
3453 report_file_error ("make server process failed", contact
);
3455 report_file_error ("make client process failed", contact
);
3462 buffer
= Fget_buffer_create (buffer
);
3463 proc
= make_process (name
);
3465 chan_process
[inch
] = proc
;
3468 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3471 fcntl (inch
, F_SETFL
, O_NDELAY
);
3475 p
= XPROCESS (proc
);
3477 pset_childp (p
, contact
);
3478 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3479 pset_type (p
, Qnetwork
);
3481 pset_buffer (p
, buffer
);
3482 pset_sentinel (p
, sentinel
);
3483 pset_filter (p
, filter
);
3484 pset_log (p
, Fplist_get (contact
, QClog
));
3485 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3486 p
->kill_without_query
= 1;
3487 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3488 pset_command (p
, Qt
);
3492 if (is_server
&& socktype
!= SOCK_DGRAM
)
3493 pset_status (p
, Qlisten
);
3495 /* Make the process marker point into the process buffer (if any). */
3496 if (BUFFERP (buffer
))
3497 set_marker_both (p
->mark
, buffer
,
3498 BUF_ZV (XBUFFER (buffer
)),
3499 BUF_ZV_BYTE (XBUFFER (buffer
)));
3501 #ifdef NON_BLOCKING_CONNECT
3502 if (is_non_blocking_client
)
3504 /* We may get here if connect did succeed immediately. However,
3505 in that case, we still need to signal this like a non-blocking
3507 pset_status (p
, Qconnect
);
3508 if (!FD_ISSET (inch
, &connect_wait_mask
))
3510 FD_SET (inch
, &connect_wait_mask
);
3511 FD_SET (inch
, &write_mask
);
3512 num_pending_connects
++;
3517 /* A server may have a client filter setting of Qt, but it must
3518 still listen for incoming connects unless it is stopped. */
3519 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3520 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3522 FD_SET (inch
, &input_wait_mask
);
3523 FD_SET (inch
, &non_keyboard_wait_mask
);
3526 if (inch
> max_process_desc
)
3527 max_process_desc
= inch
;
3529 tem
= Fplist_member (contact
, QCcoding
);
3530 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3531 tem
= Qnil
; /* No error message (too late!). */
3534 /* Setup coding systems for communicating with the network stream. */
3535 struct gcpro gcpro1
;
3536 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3537 Lisp_Object coding_systems
= Qt
;
3538 Lisp_Object fargs
[5], val
;
3542 val
= XCAR (XCDR (tem
));
3546 else if (!NILP (Vcoding_system_for_read
))
3547 val
= Vcoding_system_for_read
;
3548 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3549 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3550 /* We dare not decode end-of-line format by setting VAL to
3551 Qraw_text, because the existing Emacs Lisp libraries
3552 assume that they receive bare code including a sequence of
3557 if (NILP (host
) || NILP (service
))
3558 coding_systems
= Qnil
;
3561 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3562 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3564 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3567 if (CONSP (coding_systems
))
3568 val
= XCAR (coding_systems
);
3569 else if (CONSP (Vdefault_process_coding_system
))
3570 val
= XCAR (Vdefault_process_coding_system
);
3574 pset_decode_coding_system (p
, val
);
3578 val
= XCAR (XCDR (tem
));
3582 else if (!NILP (Vcoding_system_for_write
))
3583 val
= Vcoding_system_for_write
;
3584 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3588 if (EQ (coding_systems
, Qt
))
3590 if (NILP (host
) || NILP (service
))
3591 coding_systems
= Qnil
;
3594 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3595 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3597 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3601 if (CONSP (coding_systems
))
3602 val
= XCDR (coding_systems
);
3603 else if (CONSP (Vdefault_process_coding_system
))
3604 val
= XCDR (Vdefault_process_coding_system
);
3608 pset_encode_coding_system (p
, val
);
3610 setup_process_coding_systems (proc
);
3612 pset_decoding_buf (p
, empty_unibyte_string
);
3613 p
->decoding_carryover
= 0;
3614 pset_encoding_buf (p
, empty_unibyte_string
);
3616 p
->inherit_coding_system_flag
3617 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3624 #if defined (HAVE_NET_IF_H)
3627 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3628 doc
: /* Return an alist of all network interfaces and their network address.
3629 Each element is a cons, the car of which is a string containing the
3630 interface name, and the cdr is the network address in internal
3631 format; see the description of ADDRESS in `make-network-process'. */)
3634 struct ifconf ifconf
;
3635 struct ifreq
*ifreq
;
3637 ptrdiff_t buf_size
= 512;
3641 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3647 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
3648 ifconf
.ifc_buf
= buf
;
3649 ifconf
.ifc_len
= buf_size
;
3650 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3657 while (ifconf
.ifc_len
== buf_size
);
3662 ifreq
= ifconf
.ifc_req
;
3663 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
3665 struct ifreq
*ifq
= ifreq
;
3666 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3667 #define SIZEOF_IFREQ(sif) \
3668 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3669 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3671 int len
= SIZEOF_IFREQ (ifq
);
3673 int len
= sizeof (*ifreq
);
3675 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3677 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
3679 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3682 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3683 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3684 res
= Fcons (Fcons (build_string (namebuf
),
3685 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3686 sizeof (struct sockaddr
))),
3693 #endif /* SIOCGIFCONF */
3695 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
3699 const char *flag_sym
;
3702 static const struct ifflag_def ifflag_table
[] = {
3706 #ifdef IFF_BROADCAST
3707 { IFF_BROADCAST
, "broadcast" },
3710 { IFF_DEBUG
, "debug" },
3713 { IFF_LOOPBACK
, "loopback" },
3715 #ifdef IFF_POINTOPOINT
3716 { IFF_POINTOPOINT
, "pointopoint" },
3719 { IFF_RUNNING
, "running" },
3722 { IFF_NOARP
, "noarp" },
3725 { IFF_PROMISC
, "promisc" },
3727 #ifdef IFF_NOTRAILERS
3728 #ifdef NS_IMPL_COCOA
3729 /* Really means smart, notrailers is obsolete */
3730 { IFF_NOTRAILERS
, "smart" },
3732 { IFF_NOTRAILERS
, "notrailers" },
3736 { IFF_ALLMULTI
, "allmulti" },
3739 { IFF_MASTER
, "master" },
3742 { IFF_SLAVE
, "slave" },
3744 #ifdef IFF_MULTICAST
3745 { IFF_MULTICAST
, "multicast" },
3748 { IFF_PORTSEL
, "portsel" },
3750 #ifdef IFF_AUTOMEDIA
3751 { IFF_AUTOMEDIA
, "automedia" },
3754 { IFF_DYNAMIC
, "dynamic" },
3757 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3760 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3763 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3766 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3769 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3774 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3775 doc
: /* Return information about network interface named IFNAME.
3776 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3777 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3778 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
3779 FLAGS is the current flags of the interface. */)
3780 (Lisp_Object ifname
)
3783 Lisp_Object res
= Qnil
;
3787 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3788 && defined HAVE_GETIFADDRS && defined LLADDR)
3789 struct ifaddrs
*ifap
;
3792 CHECK_STRING (ifname
);
3794 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
3795 error ("interface name too long");
3796 strcpy (rq
.ifr_name
, SSDATA (ifname
));
3798 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3803 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
3804 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3806 int flags
= rq
.ifr_flags
;
3807 const struct ifflag_def
*fp
;
3810 /* If flags is smaller than int (i.e. short) it may have the high bit set
3811 due to IFF_MULTICAST. In that case, sign extending it into
3813 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
3814 flags
= (unsigned short) rq
.ifr_flags
;
3817 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3819 if (flags
& fp
->flag_bit
)
3821 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3822 flags
-= fp
->flag_bit
;
3825 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
3829 elt
= Fcons (make_number (fnum
), elt
);
3834 res
= Fcons (elt
, res
);
3837 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
3838 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3840 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3841 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3845 for (n
= 0; n
< 6; n
++)
3846 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3847 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3849 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
3850 if (getifaddrs (&ifap
) != -1)
3852 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3853 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3856 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
3858 struct sockaddr_dl
*sdl
= (struct sockaddr_dl
*) it
->ifa_addr
;
3859 unsigned char linkaddr
[6];
3862 if (it
->ifa_addr
->sa_family
!= AF_LINK
3863 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
3864 || sdl
->sdl_alen
!= 6)
3867 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
3868 for (n
= 0; n
< 6; n
++)
3869 p
->contents
[n
] = make_number (linkaddr
[n
]);
3871 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
3875 #ifdef HAVE_FREEIFADDRS
3879 #endif /* HAVE_GETIFADDRS && LLADDR */
3881 res
= Fcons (elt
, res
);
3884 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
3885 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3888 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3889 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3891 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3895 res
= Fcons (elt
, res
);
3898 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3899 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3902 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3905 res
= Fcons (elt
, res
);
3908 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
3909 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3912 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3915 res
= Fcons (elt
, res
);
3919 return any
? res
: Qnil
;
3922 #endif /* defined (HAVE_NET_IF_H) */
3924 /* Turn off input and output for process PROC. */
3927 deactivate_process (Lisp_Object proc
)
3929 register int inchannel
, outchannel
;
3930 register struct Lisp_Process
*p
= XPROCESS (proc
);
3933 /* Delete GnuTLS structures in PROC, if any. */
3934 emacs_gnutls_deinit (proc
);
3935 #endif /* HAVE_GNUTLS */
3937 inchannel
= p
->infd
;
3938 outchannel
= p
->outfd
;
3940 #ifdef ADAPTIVE_READ_BUFFERING
3941 if (p
->read_output_delay
> 0)
3943 if (--process_output_delay_count
< 0)
3944 process_output_delay_count
= 0;
3945 p
->read_output_delay
= 0;
3946 p
->read_output_skip
= 0;
3952 /* Beware SIGCHLD hereabouts. */
3953 flush_pending_output (inchannel
);
3954 emacs_close (inchannel
);
3955 if (outchannel
>= 0 && outchannel
!= inchannel
)
3956 emacs_close (outchannel
);
3960 #ifdef DATAGRAM_SOCKETS
3961 if (DATAGRAM_CHAN_P (inchannel
))
3963 xfree (datagram_address
[inchannel
].sa
);
3964 datagram_address
[inchannel
].sa
= 0;
3965 datagram_address
[inchannel
].len
= 0;
3968 chan_process
[inchannel
] = Qnil
;
3969 FD_CLR (inchannel
, &input_wait_mask
);
3970 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3971 #ifdef NON_BLOCKING_CONNECT
3972 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3974 FD_CLR (inchannel
, &connect_wait_mask
);
3975 FD_CLR (inchannel
, &write_mask
);
3976 if (--num_pending_connects
< 0)
3980 if (inchannel
== max_process_desc
)
3983 /* We just closed the highest-numbered process input descriptor,
3984 so recompute the highest-numbered one now. */
3985 max_process_desc
= 0;
3986 for (i
= 0; i
< MAXDESC
; i
++)
3987 if (!NILP (chan_process
[i
]))
3988 max_process_desc
= i
;
3994 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3996 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3997 It is read into the process' buffers or given to their filter functions.
3998 Non-nil arg PROCESS means do not return until some output has been received
4001 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
4002 and milliseconds to wait; return after that much time whether or not
4003 there is any subprocess output. If SECONDS is a floating point number,
4004 it specifies a fractional number of seconds to wait.
4005 The MILLISEC argument is obsolete and should be avoided.
4007 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
4008 from PROCESS, suspending reading output from other processes.
4009 If JUST-THIS-ONE is an integer, don't run any timers either.
4010 Return non-nil if we received any output before the timeout expired. */)
4011 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
4016 if (! NILP (process
))
4017 CHECK_PROCESS (process
);
4019 just_this_one
= Qnil
;
4021 if (!NILP (millisec
))
4022 { /* Obsolete calling convention using integers rather than floats. */
4023 CHECK_NUMBER (millisec
);
4025 seconds
= make_float (XINT (millisec
) / 1000.0);
4028 CHECK_NUMBER (seconds
);
4029 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4036 if (!NILP (seconds
))
4038 if (INTEGERP (seconds
))
4040 if (0 < XINT (seconds
))
4042 secs
= XINT (seconds
);
4046 else if (FLOATP (seconds
))
4048 if (0 < XFLOAT_DATA (seconds
))
4050 EMACS_TIME t
= EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds
));
4051 secs
= min (EMACS_SECS (t
), WAIT_READING_MAX
);
4052 nsecs
= EMACS_NSECS (t
);
4056 wrong_type_argument (Qnumberp
, seconds
);
4058 else if (! NILP (process
))
4062 (wait_reading_process_output (secs
, nsecs
, 0, 0,
4064 !NILP (process
) ? XPROCESS (process
) : NULL
,
4065 NILP (just_this_one
) ? 0 :
4066 !INTEGERP (just_this_one
) ? 1 : -1)
4070 /* Accept a connection for server process SERVER on CHANNEL. */
4072 static int connect_counter
= 0;
4075 server_accept_connection (Lisp_Object server
, int channel
)
4077 Lisp_Object proc
, caller
, name
, buffer
;
4078 Lisp_Object contact
, host
, service
;
4079 struct Lisp_Process
*ps
= XPROCESS (server
);
4080 struct Lisp_Process
*p
;
4084 struct sockaddr_in in
;
4086 struct sockaddr_in6 in6
;
4088 #ifdef HAVE_LOCAL_SOCKETS
4089 struct sockaddr_un un
;
4092 socklen_t len
= sizeof saddr
;
4094 s
= accept (channel
, &saddr
.sa
, &len
);
4103 if (code
== EWOULDBLOCK
)
4107 if (!NILP (ps
->log
))
4108 call3 (ps
->log
, server
, Qnil
,
4109 concat3 (build_string ("accept failed with code"),
4110 Fnumber_to_string (make_number (code
)),
4111 build_string ("\n")));
4117 /* Setup a new process to handle the connection. */
4119 /* Generate a unique identification of the caller, and build contact
4120 information for this process. */
4123 switch (saddr
.sa
.sa_family
)
4127 Lisp_Object args
[5];
4128 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4129 args
[0] = build_string ("%d.%d.%d.%d");
4130 args
[1] = make_number (*ip
++);
4131 args
[2] = make_number (*ip
++);
4132 args
[3] = make_number (*ip
++);
4133 args
[4] = make_number (*ip
++);
4134 host
= Fformat (5, args
);
4135 service
= make_number (ntohs (saddr
.in
.sin_port
));
4137 args
[0] = build_string (" <%s:%d>");
4140 caller
= Fformat (3, args
);
4147 Lisp_Object args
[9];
4148 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4150 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4151 for (i
= 0; i
< 8; i
++)
4152 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4153 host
= Fformat (9, args
);
4154 service
= make_number (ntohs (saddr
.in
.sin_port
));
4156 args
[0] = build_string (" <[%s]:%d>");
4159 caller
= Fformat (3, args
);
4164 #ifdef HAVE_LOCAL_SOCKETS
4168 caller
= Fnumber_to_string (make_number (connect_counter
));
4169 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4173 /* Create a new buffer name for this process if it doesn't have a
4174 filter. The new buffer name is based on the buffer name or
4175 process name of the server process concatenated with the caller
4178 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4182 buffer
= ps
->buffer
;
4184 buffer
= Fbuffer_name (buffer
);
4189 buffer
= concat2 (buffer
, caller
);
4190 buffer
= Fget_buffer_create (buffer
);
4194 /* Generate a unique name for the new server process. Combine the
4195 server process name with the caller identification. */
4197 name
= concat2 (ps
->name
, caller
);
4198 proc
= make_process (name
);
4200 chan_process
[s
] = proc
;
4203 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4206 fcntl (s
, F_SETFL
, O_NDELAY
);
4210 p
= XPROCESS (proc
);
4212 /* Build new contact information for this setup. */
4213 contact
= Fcopy_sequence (ps
->childp
);
4214 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4215 contact
= Fplist_put (contact
, QChost
, host
);
4216 if (!NILP (service
))
4217 contact
= Fplist_put (contact
, QCservice
, service
);
4218 contact
= Fplist_put (contact
, QCremote
,
4219 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4220 #ifdef HAVE_GETSOCKNAME
4222 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4223 contact
= Fplist_put (contact
, QClocal
,
4224 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4227 pset_childp (p
, contact
);
4228 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4229 pset_type (p
, Qnetwork
);
4231 pset_buffer (p
, buffer
);
4232 pset_sentinel (p
, ps
->sentinel
);
4233 pset_filter (p
, ps
->filter
);
4234 pset_command (p
, Qnil
);
4238 pset_status (p
, Qrun
);
4240 /* Client processes for accepted connections are not stopped initially. */
4241 if (!EQ (p
->filter
, Qt
))
4243 FD_SET (s
, &input_wait_mask
);
4244 FD_SET (s
, &non_keyboard_wait_mask
);
4247 if (s
> max_process_desc
)
4248 max_process_desc
= s
;
4250 /* Setup coding system for new process based on server process.
4251 This seems to be the proper thing to do, as the coding system
4252 of the new process should reflect the settings at the time the
4253 server socket was opened; not the current settings. */
4255 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4256 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4257 setup_process_coding_systems (proc
);
4259 pset_decoding_buf (p
, empty_unibyte_string
);
4260 p
->decoding_carryover
= 0;
4261 pset_encoding_buf (p
, empty_unibyte_string
);
4263 p
->inherit_coding_system_flag
4264 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4266 if (!NILP (ps
->log
))
4267 call3 (ps
->log
, server
, proc
,
4268 concat3 (build_string ("accept from "),
4269 (STRINGP (host
) ? host
: build_string ("-")),
4270 build_string ("\n")));
4272 if (!NILP (p
->sentinel
))
4273 exec_sentinel (proc
,
4274 concat3 (build_string ("open from "),
4275 (STRINGP (host
) ? host
: build_string ("-")),
4276 build_string ("\n")));
4279 /* This variable is different from waiting_for_input in keyboard.c.
4280 It is used to communicate to a lisp process-filter/sentinel (via the
4281 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4282 for user-input when that process-filter was called.
4283 waiting_for_input cannot be used as that is by definition 0 when
4284 lisp code is being evalled.
4285 This is also used in record_asynch_buffer_change.
4286 For that purpose, this must be 0
4287 when not inside wait_reading_process_output. */
4288 static int waiting_for_user_input_p
;
4291 wait_reading_process_output_unwind (Lisp_Object data
)
4293 waiting_for_user_input_p
= XINT (data
);
4297 /* This is here so breakpoints can be put on it. */
4299 wait_reading_process_output_1 (void)
4303 /* Read and dispose of subprocess output while waiting for timeout to
4304 elapse and/or keyboard input to be available.
4308 If negative, gobble data immediately available but don't wait for any.
4311 an additional duration to wait, measured in nanoseconds
4312 If TIME_LIMIT is zero, then:
4313 If NSECS == 0, there is no limit.
4314 If NSECS > 0, the timeout consists of NSECS only.
4315 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4318 0 to ignore keyboard input, or
4319 1 to return when input is available, or
4320 -1 meaning caller will actually read the input, so don't throw to
4321 the quit handler, or
4323 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4324 output that arrives.
4326 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4327 (and gobble terminal input into the buffer if any arrives).
4329 If WAIT_PROC is specified, wait until something arrives from that
4330 process. The return value is true if we read some input from
4333 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4334 (suspending output from other processes). A negative value
4335 means don't run any timers either.
4337 If WAIT_PROC is specified, then the function returns true if we
4338 received input from that process before the timeout elapsed.
4339 Otherwise, return true if we received input from any process. */
4342 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4344 Lisp_Object wait_for_cell
,
4345 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4347 register int channel
, nfds
;
4348 SELECT_TYPE Available
;
4349 SELECT_TYPE Writeok
;
4351 int check_delay
, no_avail
;
4354 EMACS_TIME timeout
, end_time
;
4355 int wait_channel
= -1;
4356 int got_some_input
= 0;
4357 ptrdiff_t count
= SPECPDL_INDEX ();
4359 FD_ZERO (&Available
);
4362 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4363 && !(CONSP (wait_proc
->status
)
4364 && EQ (XCAR (wait_proc
->status
), Qexit
)))
4365 message ("Blocking call to accept-process-output with quit inhibited!!");
4367 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4368 if (wait_proc
!= NULL
)
4369 wait_channel
= wait_proc
->infd
;
4371 record_unwind_protect (wait_reading_process_output_unwind
,
4372 make_number (waiting_for_user_input_p
));
4373 waiting_for_user_input_p
= read_kbd
;
4380 else if (TYPE_MAXIMUM (time_t) < time_limit
)
4381 time_limit
= TYPE_MAXIMUM (time_t);
4383 /* Since we may need to wait several times,
4384 compute the absolute time to return at. */
4385 if (time_limit
|| 0 < nsecs
)
4387 timeout
= make_emacs_time (time_limit
, nsecs
);
4388 end_time
= add_emacs_time (current_emacs_time (), timeout
);
4393 int timeout_reduced_for_timers
= 0;
4395 /* If calling from keyboard input, do not quit
4396 since we want to return C-g as an input character.
4397 Otherwise, do pending quit if requested. */
4402 process_pending_signals ();
4405 /* Exit now if the cell we're waiting for became non-nil. */
4406 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4409 /* Compute time from now till when time limit is up */
4410 /* Exit if already run out */
4413 /* A negative timeout means
4414 gobble output available now
4415 but don't wait at all. */
4417 timeout
= make_emacs_time (0, 0);
4419 else if (time_limit
|| 0 < nsecs
)
4421 EMACS_TIME now
= current_emacs_time ();
4422 if (EMACS_TIME_LE (end_time
, now
))
4424 timeout
= sub_emacs_time (end_time
, now
);
4428 timeout
= make_emacs_time (100000, 0);
4431 /* Normally we run timers here.
4432 But not if wait_for_cell; in those cases,
4433 the wait is supposed to be short,
4434 and those callers cannot handle running arbitrary Lisp code here. */
4435 if (NILP (wait_for_cell
)
4436 && just_wait_proc
>= 0)
4438 EMACS_TIME timer_delay
;
4442 int old_timers_run
= timers_run
;
4443 struct buffer
*old_buffer
= current_buffer
;
4444 Lisp_Object old_window
= selected_window
;
4446 timer_delay
= timer_check ();
4448 /* If a timer has run, this might have changed buffers
4449 an alike. Make read_key_sequence aware of that. */
4450 if (timers_run
!= old_timers_run
4451 && (old_buffer
!= current_buffer
4452 || !EQ (old_window
, selected_window
))
4453 && waiting_for_user_input_p
== -1)
4454 record_asynch_buffer_change ();
4456 if (timers_run
!= old_timers_run
&& do_display
)
4457 /* We must retry, since a timer may have requeued itself
4458 and that could alter the time_delay. */
4459 redisplay_preserve_echo_area (9);
4463 while (!detect_input_pending ());
4465 /* If there is unread keyboard input, also return. */
4467 && requeued_events_pending_p ())
4470 /* A negative timeout means do not wait at all. */
4473 if (EMACS_TIME_VALID_P (timer_delay
))
4475 if (EMACS_TIME_LT (timer_delay
, timeout
))
4477 timeout
= timer_delay
;
4478 timeout_reduced_for_timers
= 1;
4483 /* This is so a breakpoint can be put here. */
4484 wait_reading_process_output_1 ();
4489 /* Cause C-g and alarm signals to take immediate action,
4490 and cause input available signals to zero out timeout.
4492 It is important that we do this before checking for process
4493 activity. If we get a SIGCHLD after the explicit checks for
4494 process activity, timeout is the only way we will know. */
4496 set_waiting_for_input (&timeout
);
4498 /* If status of something has changed, and no input is
4499 available, notify the user of the change right away. After
4500 this explicit check, we'll let the SIGCHLD handler zap
4501 timeout to get our attention. */
4502 if (update_tick
!= process_tick
)
4507 if (kbd_on_hold_p ())
4510 Atemp
= input_wait_mask
;
4513 timeout
= make_emacs_time (0, 0);
4514 if ((pselect (max (max_process_desc
, max_input_desc
) + 1,
4516 #ifdef NON_BLOCKING_CONNECT
4517 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
4521 NULL
, &timeout
, NULL
)
4524 /* It's okay for us to do this and then continue with
4525 the loop, since timeout has already been zeroed out. */
4526 clear_waiting_for_input ();
4527 status_notify (NULL
);
4528 if (do_display
) redisplay_preserve_echo_area (13);
4532 /* Don't wait for output from a non-running process. Just
4533 read whatever data has already been received. */
4534 if (wait_proc
&& wait_proc
->raw_status_new
)
4535 update_status (wait_proc
);
4537 && ! EQ (wait_proc
->status
, Qrun
)
4538 && ! EQ (wait_proc
->status
, Qconnect
))
4540 int nread
, total_nread
= 0;
4542 clear_waiting_for_input ();
4543 XSETPROCESS (proc
, wait_proc
);
4545 /* Read data from the process, until we exhaust it. */
4546 while (wait_proc
->infd
>= 0)
4548 nread
= read_process_output (proc
, wait_proc
->infd
);
4555 total_nread
+= nread
;
4559 else if (nread
== -1 && EIO
== errno
)
4563 else if (nread
== -1 && EAGAIN
== errno
)
4567 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4571 if (total_nread
> 0 && do_display
)
4572 redisplay_preserve_echo_area (10);
4577 /* Wait till there is something to do */
4579 if (wait_proc
&& just_wait_proc
)
4581 if (wait_proc
->infd
< 0) /* Terminated */
4583 FD_SET (wait_proc
->infd
, &Available
);
4587 else if (!NILP (wait_for_cell
))
4589 Available
= non_process_wait_mask
;
4596 Available
= non_keyboard_wait_mask
;
4598 Available
= input_wait_mask
;
4599 Writeok
= write_mask
;
4600 #ifdef SELECT_CANT_DO_WRITE_MASK
4605 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4608 /* If frame size has changed or the window is newly mapped,
4609 redisplay now, before we start to wait. There is a race
4610 condition here; if a SIGIO arrives between now and the select
4611 and indicates that a frame is trashed, the select may block
4612 displaying a trashed screen. */
4613 if (frame_garbaged
&& do_display
)
4615 clear_waiting_for_input ();
4616 redisplay_preserve_echo_area (11);
4618 set_waiting_for_input (&timeout
);
4621 /* Skip the `select' call if input is available and we're
4622 waiting for keyboard input or a cell change (which can be
4623 triggered by processing X events). In the latter case, set
4624 nfds to 1 to avoid breaking the loop. */
4626 if ((read_kbd
|| !NILP (wait_for_cell
))
4627 && detect_input_pending ())
4629 nfds
= read_kbd
? 0 : 1;
4636 #ifdef ADAPTIVE_READ_BUFFERING
4637 /* Set the timeout for adaptive read buffering if any
4638 process has non-zero read_output_skip and non-zero
4639 read_output_delay, and we are not reading output for a
4640 specific wait_channel. It is not executed if
4641 Vprocess_adaptive_read_buffering is nil. */
4642 if (process_output_skip
&& check_delay
> 0)
4644 int nsecs
= EMACS_NSECS (timeout
);
4645 if (EMACS_SECS (timeout
) > 0 || nsecs
> READ_OUTPUT_DELAY_MAX
)
4646 nsecs
= READ_OUTPUT_DELAY_MAX
;
4647 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4649 proc
= chan_process
[channel
];
4652 /* Find minimum non-zero read_output_delay among the
4653 processes with non-zero read_output_skip. */
4654 if (XPROCESS (proc
)->read_output_delay
> 0)
4657 if (!XPROCESS (proc
)->read_output_skip
)
4659 FD_CLR (channel
, &Available
);
4660 XPROCESS (proc
)->read_output_skip
= 0;
4661 if (XPROCESS (proc
)->read_output_delay
< nsecs
)
4662 nsecs
= XPROCESS (proc
)->read_output_delay
;
4665 timeout
= make_emacs_time (0, nsecs
);
4666 process_output_skip
= 0;
4669 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
4671 #elif defined (HAVE_NS)
4676 (max (max_process_desc
, max_input_desc
) + 1,
4678 (check_write
? &Writeok
: (SELECT_TYPE
*)0),
4679 NULL
, &timeout
, NULL
);
4682 /* GnuTLS buffers data internally. In lowat mode it leaves
4683 some data in the TCP buffers so that select works, but
4684 with custom pull/push functions we need to check if some
4685 data is available in the buffers manually. */
4690 /* We're not waiting on a specific process, so loop
4691 through all the channels and check for data.
4692 This is a workaround needed for some versions of
4693 the gnutls library -- 2.12.14 has been confirmed
4695 http://comments.gmane.org/gmane.emacs.devel/145074 */
4696 for (channel
= 0; channel
< MAXDESC
; ++channel
)
4697 if (! NILP (chan_process
[channel
]))
4699 struct Lisp_Process
*p
=
4700 XPROCESS (chan_process
[channel
]);
4701 if (p
&& p
->gnutls_p
&& p
->infd
4702 && ((emacs_gnutls_record_check_pending
4707 FD_SET (p
->infd
, &Available
);
4713 /* Check this specific channel. */
4714 if (wait_proc
->gnutls_p
/* Check for valid process. */
4715 /* Do we have pending data? */
4716 && ((emacs_gnutls_record_check_pending
4717 (wait_proc
->gnutls_state
))
4721 /* Set to Available. */
4722 FD_SET (wait_proc
->infd
, &Available
);
4731 /* Make C-g and alarm signals set flags again */
4732 clear_waiting_for_input ();
4734 /* If we woke up due to SIGWINCH, actually change size now. */
4735 do_pending_window_change (0);
4737 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
4738 /* We waited the full specified time, so return now. */
4742 if (xerrno
== EINTR
)
4744 else if (xerrno
== EBADF
)
4747 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4748 the child's closure of the pts gives the parent a SIGHUP, and
4749 the ptc file descriptor is automatically closed,
4750 yielding EBADF here or at select() call above.
4751 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4752 in m/ibmrt-aix.h), and here we just ignore the select error.
4753 Cleanup occurs c/o status_notify after SIGCLD. */
4754 no_avail
= 1; /* Cannot depend on values returned */
4760 error ("select error: %s", emacs_strerror (xerrno
));
4765 FD_ZERO (&Available
);
4769 #if 0 /* When polling is used, interrupt_input is 0,
4770 so get_input_pending should read the input.
4771 So this should not be needed. */
4772 /* If we are using polling for input,
4773 and we see input available, make it get read now.
4774 Otherwise it might not actually get read for a second.
4775 And on hpux, since we turn off polling in wait_reading_process_output,
4776 it might never get read at all if we don't spend much time
4777 outside of wait_reading_process_output. */
4778 if (read_kbd
&& interrupt_input
4779 && keyboard_bit_set (&Available
)
4780 && input_polling_used ())
4781 kill (getpid (), SIGALRM
);
4784 /* Check for keyboard input */
4785 /* If there is any, return immediately
4786 to give it higher priority than subprocesses */
4790 int old_timers_run
= timers_run
;
4791 struct buffer
*old_buffer
= current_buffer
;
4792 Lisp_Object old_window
= selected_window
;
4795 if (detect_input_pending_run_timers (do_display
))
4797 swallow_events (do_display
);
4798 if (detect_input_pending_run_timers (do_display
))
4802 /* If a timer has run, this might have changed buffers
4803 an alike. Make read_key_sequence aware of that. */
4804 if (timers_run
!= old_timers_run
4805 && waiting_for_user_input_p
== -1
4806 && (old_buffer
!= current_buffer
4807 || !EQ (old_window
, selected_window
)))
4808 record_asynch_buffer_change ();
4814 /* If there is unread keyboard input, also return. */
4816 && requeued_events_pending_p ())
4819 /* If we are not checking for keyboard input now,
4820 do process events (but don't run any timers).
4821 This is so that X events will be processed.
4822 Otherwise they may have to wait until polling takes place.
4823 That would causes delays in pasting selections, for example.
4825 (We used to do this only if wait_for_cell.) */
4826 if (read_kbd
== 0 && detect_input_pending ())
4828 swallow_events (do_display
);
4829 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4830 if (detect_input_pending ())
4835 /* Exit now if the cell we're waiting for became non-nil. */
4836 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4840 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4841 go read it. This can happen with X on BSD after logging out.
4842 In that case, there really is no input and no SIGIO,
4843 but select says there is input. */
4845 if (read_kbd
&& interrupt_input
4846 && keyboard_bit_set (&Available
) && ! noninteractive
)
4847 kill (getpid (), SIGIO
);
4851 got_some_input
|= nfds
> 0;
4853 /* If checking input just got us a size-change event from X,
4854 obey it now if we should. */
4855 if (read_kbd
|| ! NILP (wait_for_cell
))
4856 do_pending_window_change (0);
4858 /* Check for data from a process. */
4859 if (no_avail
|| nfds
== 0)
4862 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4864 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4866 && ((d
->condition
& FOR_READ
4867 && FD_ISSET (channel
, &Available
))
4868 || (d
->condition
& FOR_WRITE
4869 && FD_ISSET (channel
, &write_mask
))))
4870 d
->func (channel
, d
->data
);
4873 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4875 if (FD_ISSET (channel
, &Available
)
4876 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4877 && !FD_ISSET (channel
, &non_process_wait_mask
))
4881 /* If waiting for this channel, arrange to return as
4882 soon as no more input to be processed. No more
4884 if (wait_channel
== channel
)
4890 proc
= chan_process
[channel
];
4894 /* If this is a server stream socket, accept connection. */
4895 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4897 server_accept_connection (proc
, channel
);
4901 /* Read data from the process, starting with our
4902 buffered-ahead character if we have one. */
4904 nread
= read_process_output (proc
, channel
);
4907 /* Since read_process_output can run a filter,
4908 which can call accept-process-output,
4909 don't try to read from any other processes
4910 before doing the select again. */
4911 FD_ZERO (&Available
);
4914 redisplay_preserve_echo_area (12);
4917 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4920 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4921 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4923 else if (nread
== -1 && errno
== EAGAIN
)
4927 else if (nread
== -1 && errno
== EAGAIN
)
4929 /* Note that we cannot distinguish between no input
4930 available now and a closed pipe.
4931 With luck, a closed pipe will be accompanied by
4932 subprocess termination and SIGCHLD. */
4933 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4935 #endif /* O_NDELAY */
4936 #endif /* O_NONBLOCK */
4938 /* On some OSs with ptys, when the process on one end of
4939 a pty exits, the other end gets an error reading with
4940 errno = EIO instead of getting an EOF (0 bytes read).
4941 Therefore, if we get an error reading and errno =
4942 EIO, just continue, because the child process has
4943 exited and should clean itself up soon (e.g. when we
4946 However, it has been known to happen that the SIGCHLD
4947 got lost. So raise the signal again just in case.
4949 else if (nread
== -1 && errno
== EIO
)
4951 struct Lisp_Process
*p
= XPROCESS (proc
);
4953 /* Clear the descriptor now, so we only raise the
4955 FD_CLR (channel
, &input_wait_mask
);
4956 FD_CLR (channel
, &non_keyboard_wait_mask
);
4960 /* If the EIO occurs on a pty, the SIGCHLD handler's
4961 waitpid call will not find the process object to
4962 delete. Do it here. */
4963 p
->tick
= ++process_tick
;
4964 pset_status (p
, Qfailed
);
4967 kill (getpid (), SIGCHLD
);
4969 #endif /* HAVE_PTYS */
4970 /* If we can detect process termination, don't consider the
4971 process gone just because its pipe is closed. */
4973 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4978 /* Preserve status of processes already terminated. */
4979 XPROCESS (proc
)->tick
= ++process_tick
;
4980 deactivate_process (proc
);
4981 if (XPROCESS (proc
)->raw_status_new
)
4982 update_status (XPROCESS (proc
));
4983 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4984 pset_status (XPROCESS (proc
),
4985 list2 (Qexit
, make_number (256)));
4988 #ifdef NON_BLOCKING_CONNECT
4989 if (FD_ISSET (channel
, &Writeok
)
4990 && FD_ISSET (channel
, &connect_wait_mask
))
4992 struct Lisp_Process
*p
;
4994 FD_CLR (channel
, &connect_wait_mask
);
4995 FD_CLR (channel
, &write_mask
);
4996 if (--num_pending_connects
< 0)
4999 proc
= chan_process
[channel
];
5003 p
= XPROCESS (proc
);
5006 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5007 So only use it on systems where it is known to work. */
5009 socklen_t xlen
= sizeof (xerrno
);
5010 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5015 struct sockaddr pname
;
5016 int pnamelen
= sizeof (pname
);
5018 /* If connection failed, getpeername will fail. */
5020 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5022 /* Obtain connect failure code through error slippage. */
5025 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5032 p
->tick
= ++process_tick
;
5033 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
5034 deactivate_process (proc
);
5038 pset_status (p
, Qrun
);
5039 /* Execute the sentinel here. If we had relied on
5040 status_notify to do it later, it will read input
5041 from the process before calling the sentinel. */
5042 exec_sentinel (proc
, build_string ("open\n"));
5043 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
5045 FD_SET (p
->infd
, &input_wait_mask
);
5046 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5050 #endif /* NON_BLOCKING_CONNECT */
5051 } /* end for each file descriptor */
5052 } /* end while exit conditions not met */
5054 unbind_to (count
, Qnil
);
5056 /* If calling from keyboard input, do not quit
5057 since we want to return C-g as an input character.
5058 Otherwise, do pending quit if requested. */
5061 /* Prevent input_pending from remaining set if we quit. */
5062 clear_input_pending ();
5066 return got_some_input
;
5069 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5072 read_process_output_call (Lisp_Object fun_and_args
)
5074 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5078 read_process_output_error_handler (Lisp_Object error_val
)
5080 cmd_error_internal (error_val
, "error in process filter: ");
5082 update_echo_area ();
5083 Fsleep_for (make_number (2), Qnil
);
5087 /* Read pending output from the process channel,
5088 starting with our buffered-ahead character if we have one.
5089 Yield number of decoded characters read.
5091 This function reads at most 4096 characters.
5092 If you want to read all available subprocess output,
5093 you must call it repeatedly until it returns zero.
5095 The characters read are decoded according to PROC's coding-system
5099 read_process_output (Lisp_Object proc
, register int channel
)
5101 register ssize_t nbytes
;
5103 register Lisp_Object outstream
;
5104 register struct Lisp_Process
*p
= XPROCESS (proc
);
5105 register ptrdiff_t opoint
;
5106 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5107 int carryover
= p
->decoding_carryover
;
5109 ptrdiff_t count
= SPECPDL_INDEX ();
5110 Lisp_Object odeactivate
;
5112 chars
= alloca (carryover
+ readmax
);
5114 /* See the comment above. */
5115 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5117 #ifdef DATAGRAM_SOCKETS
5118 /* We have a working select, so proc_buffered_char is always -1. */
5119 if (DATAGRAM_CHAN_P (channel
))
5121 socklen_t len
= datagram_address
[channel
].len
;
5122 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5123 0, datagram_address
[channel
].sa
, &len
);
5128 int buffered
= 0 <= proc_buffered_char
[channel
];
5131 chars
[carryover
] = proc_buffered_char
[channel
];
5132 proc_buffered_char
[channel
] = -1;
5136 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5137 readmax
- buffered
);
5140 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5141 readmax
- buffered
);
5142 #ifdef ADAPTIVE_READ_BUFFERING
5143 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5145 int delay
= p
->read_output_delay
;
5148 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5151 process_output_delay_count
++;
5152 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5155 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5157 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5159 process_output_delay_count
--;
5161 p
->read_output_delay
= delay
;
5164 p
->read_output_skip
= 1;
5165 process_output_skip
= 1;
5170 nbytes
+= buffered
&& nbytes
<= 0;
5173 p
->decoding_carryover
= 0;
5175 /* At this point, NBYTES holds number of bytes just received
5176 (including the one in proc_buffered_char[channel]). */
5179 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5181 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5184 /* Now set NBYTES how many bytes we must decode. */
5185 nbytes
+= carryover
;
5187 odeactivate
= Vdeactivate_mark
;
5188 /* There's no good reason to let process filters change the current
5189 buffer, and many callers of accept-process-output, sit-for, and
5190 friends don't expect current-buffer to be changed from under them. */
5191 record_unwind_current_buffer ();
5193 /* Read and dispose of the process output. */
5194 outstream
= p
->filter
;
5195 if (!NILP (outstream
))
5198 bool outer_running_asynch_code
= running_asynch_code
;
5199 int waiting
= waiting_for_user_input_p
;
5201 /* No need to gcpro these, because all we do with them later
5202 is test them for EQness, and none of them should be a string. */
5204 Lisp_Object obuffer
, okeymap
;
5205 XSETBUFFER (obuffer
, current_buffer
);
5206 okeymap
= BVAR (current_buffer
, keymap
);
5209 /* We inhibit quit here instead of just catching it so that
5210 hitting ^G when a filter happens to be running won't screw
5212 specbind (Qinhibit_quit
, Qt
);
5213 specbind (Qlast_nonmenu_event
, Qt
);
5215 /* In case we get recursively called,
5216 and we already saved the match data nonrecursively,
5217 save the same match data in safely recursive fashion. */
5218 if (outer_running_asynch_code
)
5221 /* Don't clobber the CURRENT match data, either! */
5222 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5223 restore_search_regs ();
5224 record_unwind_save_match_data ();
5225 Fset_match_data (tem
, Qt
);
5228 /* For speed, if a search happens within this code,
5229 save the match data in a special nonrecursive fashion. */
5230 running_asynch_code
= 1;
5232 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5233 text
= coding
->dst_object
;
5234 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5235 /* A new coding system might be found. */
5236 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5238 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5240 /* Don't call setup_coding_system for
5241 proc_decode_coding_system[channel] here. It is done in
5242 detect_coding called via decode_coding above. */
5244 /* If a coding system for encoding is not yet decided, we set
5245 it as the same as coding-system for decoding.
5247 But, before doing that we must check if
5248 proc_encode_coding_system[p->outfd] surely points to a
5249 valid memory because p->outfd will be changed once EOF is
5250 sent to the process. */
5251 if (NILP (p
->encode_coding_system
)
5252 && proc_encode_coding_system
[p
->outfd
])
5254 pset_encode_coding_system
5255 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5256 setup_coding_system (p
->encode_coding_system
,
5257 proc_encode_coding_system
[p
->outfd
]);
5261 if (coding
->carryover_bytes
> 0)
5263 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5264 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5265 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5266 coding
->carryover_bytes
);
5267 p
->decoding_carryover
= coding
->carryover_bytes
;
5269 if (SBYTES (text
) > 0)
5270 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5271 sometimes it's simply wrong to wrap (e.g. when called from
5272 accept-process-output). */
5273 internal_condition_case_1 (read_process_output_call
,
5275 Fcons (proc
, Fcons (text
, Qnil
))),
5276 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5277 read_process_output_error_handler
);
5279 /* If we saved the match data nonrecursively, restore it now. */
5280 restore_search_regs ();
5281 running_asynch_code
= outer_running_asynch_code
;
5283 /* Restore waiting_for_user_input_p as it was
5284 when we were called, in case the filter clobbered it. */
5285 waiting_for_user_input_p
= waiting
;
5287 #if 0 /* Call record_asynch_buffer_change unconditionally,
5288 because we might have changed minor modes or other things
5289 that affect key bindings. */
5290 if (! EQ (Fcurrent_buffer (), obuffer
)
5291 || ! EQ (current_buffer
->keymap
, okeymap
))
5293 /* But do it only if the caller is actually going to read events.
5294 Otherwise there's no need to make him wake up, and it could
5295 cause trouble (for example it would make sit_for return). */
5296 if (waiting_for_user_input_p
== -1)
5297 record_asynch_buffer_change ();
5300 /* If no filter, write into buffer if it isn't dead. */
5301 else if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
5303 Lisp_Object old_read_only
;
5304 ptrdiff_t old_begv
, old_zv
;
5305 ptrdiff_t old_begv_byte
, old_zv_byte
;
5306 ptrdiff_t before
, before_byte
;
5307 ptrdiff_t opoint_byte
;
5311 Fset_buffer (p
->buffer
);
5313 opoint_byte
= PT_BYTE
;
5314 old_read_only
= BVAR (current_buffer
, read_only
);
5317 old_begv_byte
= BEGV_BYTE
;
5318 old_zv_byte
= ZV_BYTE
;
5320 bset_read_only (current_buffer
, Qnil
);
5322 /* Insert new output into buffer
5323 at the current end-of-output marker,
5324 thus preserving logical ordering of input and output. */
5325 if (XMARKER (p
->mark
)->buffer
)
5326 SET_PT_BOTH (clip_to_bounds (BEGV
,
5327 marker_position (p
->mark
), ZV
),
5328 clip_to_bounds (BEGV_BYTE
,
5329 marker_byte_position (p
->mark
),
5332 SET_PT_BOTH (ZV
, ZV_BYTE
);
5334 before_byte
= PT_BYTE
;
5336 /* If the output marker is outside of the visible region, save
5337 the restriction and widen. */
5338 if (! (BEGV
<= PT
&& PT
<= ZV
))
5341 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5342 text
= coding
->dst_object
;
5343 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5344 /* A new coding system might be found. See the comment in the
5345 similar code in the previous `if' block. */
5346 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5348 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5349 if (NILP (p
->encode_coding_system
)
5350 && proc_encode_coding_system
[p
->outfd
])
5352 pset_encode_coding_system
5353 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5354 setup_coding_system (p
->encode_coding_system
,
5355 proc_encode_coding_system
[p
->outfd
]);
5358 if (coding
->carryover_bytes
> 0)
5360 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5361 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5362 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5363 coding
->carryover_bytes
);
5364 p
->decoding_carryover
= coding
->carryover_bytes
;
5366 /* Adjust the multibyteness of TEXT to that of the buffer. */
5367 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5368 != ! STRING_MULTIBYTE (text
))
5369 text
= (STRING_MULTIBYTE (text
)
5370 ? Fstring_as_unibyte (text
)
5371 : Fstring_to_multibyte (text
));
5372 /* Insert before markers in case we are inserting where
5373 the buffer's mark is, and the user's next command is Meta-y. */
5374 insert_from_string_before_markers (text
, 0, 0,
5375 SCHARS (text
), SBYTES (text
), 0);
5377 /* Make sure the process marker's position is valid when the
5378 process buffer is changed in the signal_after_change above.
5379 W3 is known to do that. */
5380 if (BUFFERP (p
->buffer
)
5381 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5382 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5384 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5386 update_mode_lines
++;
5388 /* Make sure opoint and the old restrictions
5389 float ahead of any new text just as point would. */
5390 if (opoint
>= before
)
5392 opoint
+= PT
- before
;
5393 opoint_byte
+= PT_BYTE
- before_byte
;
5395 if (old_begv
> before
)
5397 old_begv
+= PT
- before
;
5398 old_begv_byte
+= PT_BYTE
- before_byte
;
5400 if (old_zv
>= before
)
5402 old_zv
+= PT
- before
;
5403 old_zv_byte
+= PT_BYTE
- before_byte
;
5406 /* If the restriction isn't what it should be, set it. */
5407 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5408 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5411 bset_read_only (current_buffer
, old_read_only
);
5412 SET_PT_BOTH (opoint
, opoint_byte
);
5414 /* Handling the process output should not deactivate the mark. */
5415 Vdeactivate_mark
= odeactivate
;
5417 unbind_to (count
, Qnil
);
5421 /* Sending data to subprocess */
5423 static jmp_buf send_process_frame
;
5424 static Lisp_Object process_sent_to
;
5426 static _Noreturn
void
5427 handle_pipe_signal (int sig
)
5430 sigemptyset (&unblocked
);
5431 sigaddset (&unblocked
, SIGPIPE
);
5432 pthread_sigmask (SIG_UNBLOCK
, &unblocked
, 0);
5433 _longjmp (send_process_frame
, 1);
5437 deliver_pipe_signal (int sig
)
5439 handle_on_main_thread (sig
, handle_pipe_signal
);
5442 /* In send_process, when a write fails temporarily,
5443 wait_reading_process_output is called. It may execute user code,
5444 e.g. timers, that attempts to write new data to the same process.
5445 We must ensure that data is sent in the right order, and not
5446 interspersed half-completed with other writes (Bug#10815). This is
5447 handled by the write_queue element of struct process. It is a list
5448 with each entry having the form
5450 (string . (offset . length))
5452 where STRING is a lisp string, OFFSET is the offset into the
5453 string's byte sequence from which we should begin to send, and
5454 LENGTH is the number of bytes left to send. */
5456 /* Create a new entry in write_queue.
5457 INPUT_OBJ should be a buffer, string Qt, or Qnil.
5458 BUF is a pointer to the string sequence of the input_obj or a C
5459 string in case of Qt or Qnil. */
5462 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
5463 const char *buf
, ptrdiff_t len
, int front
)
5466 Lisp_Object entry
, obj
;
5468 if (STRINGP (input_obj
))
5470 offset
= buf
- SSDATA (input_obj
);
5476 obj
= make_unibyte_string (buf
, len
);
5479 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
5482 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
5484 pset_write_queue (p
, nconc2 (p
->write_queue
, Fcons (entry
, Qnil
)));
5487 /* Remove the first element in the write_queue of process P, put its
5488 contents in OBJ, BUF and LEN, and return non-zero. If the
5489 write_queue is empty, return zero. */
5492 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
5493 const char **buf
, ptrdiff_t *len
)
5495 Lisp_Object entry
, offset_length
;
5498 if (NILP (p
->write_queue
))
5501 entry
= XCAR (p
->write_queue
);
5502 pset_write_queue (p
, XCDR (p
->write_queue
));
5504 *obj
= XCAR (entry
);
5505 offset_length
= XCDR (entry
);
5507 *len
= XINT (XCDR (offset_length
));
5508 offset
= XINT (XCAR (offset_length
));
5509 *buf
= SSDATA (*obj
) + offset
;
5514 /* Send some data to process PROC.
5515 BUF is the beginning of the data; LEN is the number of characters.
5516 OBJECT is the Lisp object that the data comes from. If OBJECT is
5517 nil or t, it means that the data comes from C string.
5519 If OBJECT is not nil, the data is encoded by PROC's coding-system
5520 for encoding before it is sent.
5522 This function can evaluate Lisp code and can garbage collect. */
5525 send_process (volatile Lisp_Object proc
, const char *volatile buf
,
5526 volatile ptrdiff_t len
, volatile Lisp_Object object
)
5528 /* Use volatile to protect variables from being clobbered by longjmp. */
5529 struct Lisp_Process
*p
= XPROCESS (proc
);
5531 struct coding_system
*coding
;
5532 struct sigaction old_sigpipe_action
;
5534 if (p
->raw_status_new
)
5536 if (! EQ (p
->status
, Qrun
))
5537 error ("Process %s not running", SDATA (p
->name
));
5539 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5541 coding
= proc_encode_coding_system
[p
->outfd
];
5542 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5544 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5545 || (BUFFERP (object
)
5546 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
5549 pset_encode_coding_system
5550 (p
, complement_process_encoding_system (p
->encode_coding_system
));
5551 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5553 /* The coding system for encoding was changed to raw-text
5554 because we sent a unibyte text previously. Now we are
5555 sending a multibyte text, thus we must encode it by the
5556 original coding system specified for the current process.
5558 Another reason we come here is that the coding system
5559 was just complemented and a new one was returned by
5560 complement_process_encoding_system. */
5561 setup_coding_system (p
->encode_coding_system
, coding
);
5562 Vlast_coding_system_used
= p
->encode_coding_system
;
5564 coding
->src_multibyte
= 1;
5568 coding
->src_multibyte
= 0;
5569 /* For sending a unibyte text, character code conversion should
5570 not take place but EOL conversion should. So, setup raw-text
5571 or one of the subsidiary if we have not yet done it. */
5572 if (CODING_REQUIRE_ENCODING (coding
))
5574 if (CODING_REQUIRE_FLUSHING (coding
))
5576 /* But, before changing the coding, we must flush out data. */
5577 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5578 send_process (proc
, "", 0, Qt
);
5579 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5581 setup_coding_system (raw_text_coding_system
5582 (Vlast_coding_system_used
),
5584 coding
->src_multibyte
= 0;
5587 coding
->dst_multibyte
= 0;
5589 if (CODING_REQUIRE_ENCODING (coding
))
5591 coding
->dst_object
= Qt
;
5592 if (BUFFERP (object
))
5594 ptrdiff_t from_byte
, from
, to
;
5595 ptrdiff_t save_pt
, save_pt_byte
;
5596 struct buffer
*cur
= current_buffer
;
5598 set_buffer_internal (XBUFFER (object
));
5599 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5601 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
5602 from
= BYTE_TO_CHAR (from_byte
);
5603 to
= BYTE_TO_CHAR (from_byte
+ len
);
5604 TEMP_SET_PT_BOTH (from
, from_byte
);
5605 encode_coding_object (coding
, object
, from
, from_byte
,
5606 to
, from_byte
+ len
, Qt
);
5607 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5608 set_buffer_internal (cur
);
5610 else if (STRINGP (object
))
5612 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5613 SBYTES (object
), Qt
);
5617 coding
->dst_object
= make_unibyte_string (buf
, len
);
5618 coding
->produced
= len
;
5621 len
= coding
->produced
;
5622 object
= coding
->dst_object
;
5623 buf
= SSDATA (object
);
5626 if (pty_max_bytes
== 0)
5628 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5629 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5630 if (pty_max_bytes
< 0)
5631 pty_max_bytes
= 250;
5633 pty_max_bytes
= 250;
5635 /* Deduct one, to leave space for the eof. */
5639 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5640 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5641 when returning with longjmp despite being declared volatile. */
5642 if (!_setjmp (send_process_frame
))
5644 p
= XPROCESS (proc
); /* Repair any setjmp clobbering. */
5645 process_sent_to
= proc
;
5647 /* If there is already data in the write_queue, put the new data
5648 in the back of queue. Otherwise, ignore it. */
5649 if (!NILP (p
->write_queue
))
5650 write_queue_push (p
, object
, buf
, len
, 0);
5652 do /* while !NILP (p->write_queue) */
5654 ptrdiff_t cur_len
= -1;
5655 const char *cur_buf
;
5656 Lisp_Object cur_object
;
5658 /* If write_queue is empty, ignore it. */
5659 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
5663 cur_object
= object
;
5668 /* Send this batch, using one or more write calls. */
5669 ptrdiff_t written
= 0;
5670 int outfd
= p
->outfd
;
5671 struct sigaction action
;
5672 emacs_sigaction_init (&action
, deliver_pipe_signal
);
5673 sigaction (SIGPIPE
, &action
, &old_sigpipe_action
);
5674 #ifdef DATAGRAM_SOCKETS
5675 if (DATAGRAM_CHAN_P (outfd
))
5677 rv
= sendto (outfd
, cur_buf
, cur_len
,
5678 0, datagram_address
[outfd
].sa
,
5679 datagram_address
[outfd
].len
);
5682 else if (errno
== EMSGSIZE
)
5684 sigaction (SIGPIPE
, &old_sigpipe_action
, 0);
5685 report_file_error ("sending datagram",
5686 Fcons (proc
, Qnil
));
5694 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
5697 written
= emacs_write (outfd
, cur_buf
, cur_len
);
5698 rv
= (written
? 0 : -1);
5699 #ifdef ADAPTIVE_READ_BUFFERING
5700 if (p
->read_output_delay
> 0
5701 && p
->adaptive_read_buffering
== 1)
5703 p
->read_output_delay
= 0;
5704 process_output_delay_count
--;
5705 p
->read_output_skip
= 0;
5709 sigaction (SIGPIPE
, &old_sigpipe_action
, 0);
5715 || errno
== EWOULDBLOCK
5721 /* Buffer is full. Wait, accepting input;
5722 that may allow the program
5723 to finish doing output and read more. */
5725 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5726 /* A gross hack to work around a bug in FreeBSD.
5727 In the following sequence, read(2) returns
5731 write(2) 954 bytes, get EAGAIN
5732 read(2) 1024 bytes in process_read_output
5733 read(2) 11 bytes in process_read_output
5735 That is, read(2) returns more bytes than have
5736 ever been written successfully. The 1033 bytes
5737 read are the 1022 bytes written successfully
5738 after processing (for example with CRs added if
5739 the terminal is set up that way which it is
5740 here). The same bytes will be seen again in a
5741 later read(2), without the CRs. */
5743 if (errno
== EAGAIN
)
5746 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5748 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5750 /* Put what we should have written in wait_queue. */
5751 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
5752 wait_reading_process_output (0, 20 * 1000 * 1000,
5753 0, 0, Qnil
, NULL
, 0);
5754 /* Reread queue, to see what is left. */
5758 /* This is a real error. */
5759 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5765 while (!NILP (p
->write_queue
));
5769 sigaction (SIGPIPE
, &old_sigpipe_action
, 0);
5770 proc
= process_sent_to
;
5771 p
= XPROCESS (proc
);
5772 p
->raw_status_new
= 0;
5773 pset_status (p
, Fcons (Qexit
, Fcons (make_number (256), Qnil
)));
5774 p
->tick
= ++process_tick
;
5775 deactivate_process (proc
);
5776 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5780 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5782 doc
: /* Send current contents of region as input to PROCESS.
5783 PROCESS may be a process, a buffer, the name of a process or buffer, or
5784 nil, indicating the current buffer's process.
5785 Called from program, takes three arguments, PROCESS, START and END.
5786 If the region is more than 500 characters long,
5787 it is sent in several bunches. This may happen even for shorter regions.
5788 Output from processes can arrive in between bunches. */)
5789 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5792 ptrdiff_t start1
, end1
;
5794 proc
= get_process (process
);
5795 validate_region (&start
, &end
);
5797 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5798 move_gap (XINT (start
));
5800 start1
= CHAR_TO_BYTE (XINT (start
));
5801 end1
= CHAR_TO_BYTE (XINT (end
));
5802 send_process (proc
, (char *) BYTE_POS_ADDR (start1
), end1
- start1
,
5803 Fcurrent_buffer ());
5808 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5810 doc
: /* Send PROCESS the contents of STRING as input.
5811 PROCESS may be a process, a buffer, the name of a process or buffer, or
5812 nil, indicating the current buffer's process.
5813 If STRING is more than 500 characters long,
5814 it is sent in several bunches. This may happen even for shorter strings.
5815 Output from processes can arrive in between bunches. */)
5816 (Lisp_Object process
, Lisp_Object string
)
5819 CHECK_STRING (string
);
5820 proc
= get_process (process
);
5821 send_process (proc
, SSDATA (string
),
5822 SBYTES (string
), string
);
5826 /* Return the foreground process group for the tty/pty that
5827 the process P uses. */
5829 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5834 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5837 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5838 master side. Try the slave side. */
5839 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
5843 ioctl (fd
, TIOCGPGRP
, &gid
);
5847 #endif /* defined (TIOCGPGRP ) */
5852 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5853 Sprocess_running_child_p
, 0, 1, 0,
5854 doc
: /* Return t if PROCESS has given the terminal to a child.
5855 If the operating system does not make it possible to find out,
5856 return t unconditionally. */)
5857 (Lisp_Object process
)
5859 /* Initialize in case ioctl doesn't exist or gives an error,
5860 in a way that will cause returning t. */
5863 struct Lisp_Process
*p
;
5865 proc
= get_process (process
);
5866 p
= XPROCESS (proc
);
5868 if (!EQ (p
->type
, Qreal
))
5869 error ("Process %s is not a subprocess",
5872 error ("Process %s is not active",
5875 gid
= emacs_get_tty_pgrp (p
);
5882 /* send a signal number SIGNO to PROCESS.
5883 If CURRENT_GROUP is t, that means send to the process group
5884 that currently owns the terminal being used to communicate with PROCESS.
5885 This is used for various commands in shell mode.
5886 If CURRENT_GROUP is lambda, that means send to the process group
5887 that currently owns the terminal, but only if it is NOT the shell itself.
5889 If NOMSG is zero, insert signal-announcements into process's buffers
5892 If we can, we try to signal PROCESS by sending control characters
5893 down the pty. This allows us to signal inferiors who have changed
5894 their uid, for which killpg would return an EPERM error. */
5897 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5901 register struct Lisp_Process
*p
;
5905 proc
= get_process (process
);
5906 p
= XPROCESS (proc
);
5908 if (!EQ (p
->type
, Qreal
))
5909 error ("Process %s is not a subprocess",
5912 error ("Process %s is not active",
5916 current_group
= Qnil
;
5918 /* If we are using pgrps, get a pgrp number and make it negative. */
5919 if (NILP (current_group
))
5920 /* Send the signal to the shell's process group. */
5924 #ifdef SIGNALS_VIA_CHARACTERS
5925 /* If possible, send signals to the entire pgrp
5926 by sending an input character to it. */
5929 cc_t
*sig_char
= NULL
;
5931 tcgetattr (p
->infd
, &t
);
5936 sig_char
= &t
.c_cc
[VINTR
];
5940 sig_char
= &t
.c_cc
[VQUIT
];
5944 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5945 sig_char
= &t
.c_cc
[VSWTCH
];
5947 sig_char
= &t
.c_cc
[VSUSP
];
5952 if (sig_char
&& *sig_char
!= CDISABLE
)
5954 send_process (proc
, (char *) sig_char
, 1, Qnil
);
5957 /* If we can't send the signal with a character,
5958 fall through and send it another way. */
5960 /* The code above may fall through if it can't
5961 handle the signal. */
5962 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5965 /* Get the current pgrp using the tty itself, if we have that.
5966 Otherwise, use the pty to get the pgrp.
5967 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5968 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5969 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5970 His patch indicates that if TIOCGPGRP returns an error, then
5971 we should just assume that p->pid is also the process group id. */
5973 gid
= emacs_get_tty_pgrp (p
);
5976 /* If we can't get the information, assume
5977 the shell owns the tty. */
5980 /* It is not clear whether anything really can set GID to -1.
5981 Perhaps on some system one of those ioctls can or could do so.
5982 Or perhaps this is vestigial. */
5985 #else /* ! defined (TIOCGPGRP ) */
5986 /* Can't select pgrps on this system, so we know that
5987 the child itself heads the pgrp. */
5989 #endif /* ! defined (TIOCGPGRP ) */
5991 /* If current_group is lambda, and the shell owns the terminal,
5992 don't send any signal. */
5993 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6001 p
->raw_status_new
= 0;
6002 pset_status (p
, Qrun
);
6003 p
->tick
= ++process_tick
;
6006 status_notify (NULL
);
6007 redisplay_preserve_echo_area (13);
6010 #endif /* ! defined (SIGCONT) */
6014 flush_pending_output (p
->infd
);
6018 /* If we don't have process groups, send the signal to the immediate
6019 subprocess. That isn't really right, but it's better than any
6020 obvious alternative. */
6023 kill (p
->pid
, signo
);
6027 /* gid may be a pid, or minus a pgrp's number */
6029 if (!NILP (current_group
))
6031 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
6032 EMACS_KILLPG (gid
, signo
);
6039 #else /* ! defined (TIOCSIGSEND) */
6040 EMACS_KILLPG (gid
, signo
);
6041 #endif /* ! defined (TIOCSIGSEND) */
6044 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6045 doc
: /* Interrupt process PROCESS.
6046 PROCESS may be a process, a buffer, or the name of a process or buffer.
6047 No arg or nil means current buffer's process.
6048 Second arg CURRENT-GROUP non-nil means send signal to
6049 the current process-group of the process's controlling terminal
6050 rather than to the process's own process group.
6051 If the process is a shell, this means interrupt current subjob
6052 rather than the shell.
6054 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6055 don't send the signal. */)
6056 (Lisp_Object process
, Lisp_Object current_group
)
6058 process_send_signal (process
, SIGINT
, current_group
, 0);
6062 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6063 doc
: /* Kill process PROCESS. May be process or name of one.
6064 See function `interrupt-process' for more details on usage. */)
6065 (Lisp_Object process
, Lisp_Object current_group
)
6067 process_send_signal (process
, SIGKILL
, current_group
, 0);
6071 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6072 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6073 See function `interrupt-process' for more details on usage. */)
6074 (Lisp_Object process
, Lisp_Object current_group
)
6076 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6080 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6081 doc
: /* Stop process PROCESS. May be process or name of one.
6082 See function `interrupt-process' for more details on usage.
6083 If PROCESS is a network or serial process, inhibit handling of incoming
6085 (Lisp_Object process
, Lisp_Object current_group
)
6087 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6089 struct Lisp_Process
*p
;
6091 p
= XPROCESS (process
);
6092 if (NILP (p
->command
)
6095 FD_CLR (p
->infd
, &input_wait_mask
);
6096 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6098 pset_command (p
, Qt
);
6102 error ("No SIGTSTP support");
6104 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6109 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6110 doc
: /* Continue process PROCESS. May be process or name of one.
6111 See function `interrupt-process' for more details on usage.
6112 If PROCESS is a network or serial process, resume handling of incoming
6114 (Lisp_Object process
, Lisp_Object current_group
)
6116 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6118 struct Lisp_Process
*p
;
6120 p
= XPROCESS (process
);
6121 if (EQ (p
->command
, Qt
)
6123 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6125 FD_SET (p
->infd
, &input_wait_mask
);
6126 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6128 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6129 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6130 #else /* not WINDOWSNT */
6131 tcflush (p
->infd
, TCIFLUSH
);
6132 #endif /* not WINDOWSNT */
6134 pset_command (p
, Qnil
);
6138 process_send_signal (process
, SIGCONT
, current_group
, 0);
6140 error ("No SIGCONT support");
6145 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6146 2, 2, "sProcess (name or number): \nnSignal code: ",
6147 doc
: /* Send PROCESS the signal with code SIGCODE.
6148 PROCESS may also be a number specifying the process id of the
6149 process to signal; in this case, the process need not be a child of
6151 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6152 (Lisp_Object process
, Lisp_Object sigcode
)
6156 if (STRINGP (process
))
6158 Lisp_Object tem
= Fget_process (process
);
6161 Lisp_Object process_number
=
6162 string_to_number (SSDATA (process
), 10, 1);
6163 if (INTEGERP (process_number
) || FLOATP (process_number
))
6164 tem
= process_number
;
6168 else if (!NUMBERP (process
))
6169 process
= get_process (process
);
6174 if (NUMBERP (process
))
6175 CONS_TO_INTEGER (process
, pid_t
, pid
);
6178 CHECK_PROCESS (process
);
6179 pid
= XPROCESS (process
)->pid
;
6181 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6184 #define parse_signal(NAME, VALUE) \
6185 else if (!xstrcasecmp (name, NAME)) \
6186 XSETINT (sigcode, VALUE)
6188 if (INTEGERP (sigcode
))
6189 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6194 CHECK_SYMBOL (sigcode
);
6195 name
= SSDATA (SYMBOL_NAME (sigcode
));
6197 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6203 parse_signal ("usr1", SIGUSR1
);
6206 parse_signal ("usr2", SIGUSR2
);
6209 parse_signal ("term", SIGTERM
);
6212 parse_signal ("hup", SIGHUP
);
6215 parse_signal ("int", SIGINT
);
6218 parse_signal ("quit", SIGQUIT
);
6221 parse_signal ("ill", SIGILL
);
6224 parse_signal ("abrt", SIGABRT
);
6227 parse_signal ("emt", SIGEMT
);
6230 parse_signal ("kill", SIGKILL
);
6233 parse_signal ("fpe", SIGFPE
);
6236 parse_signal ("bus", SIGBUS
);
6239 parse_signal ("segv", SIGSEGV
);
6242 parse_signal ("sys", SIGSYS
);
6245 parse_signal ("pipe", SIGPIPE
);
6248 parse_signal ("alrm", SIGALRM
);
6251 parse_signal ("urg", SIGURG
);
6254 parse_signal ("stop", SIGSTOP
);
6257 parse_signal ("tstp", SIGTSTP
);
6260 parse_signal ("cont", SIGCONT
);
6263 parse_signal ("chld", SIGCHLD
);
6266 parse_signal ("ttin", SIGTTIN
);
6269 parse_signal ("ttou", SIGTTOU
);
6272 parse_signal ("io", SIGIO
);
6275 parse_signal ("xcpu", SIGXCPU
);
6278 parse_signal ("xfsz", SIGXFSZ
);
6281 parse_signal ("vtalrm", SIGVTALRM
);
6284 parse_signal ("prof", SIGPROF
);
6287 parse_signal ("winch", SIGWINCH
);
6290 parse_signal ("info", SIGINFO
);
6293 error ("Undefined signal name %s", name
);
6298 return make_number (kill (pid
, XINT (sigcode
)));
6301 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6302 doc
: /* Make PROCESS see end-of-file in its input.
6303 EOF comes after any text already sent to it.
6304 PROCESS may be a process, a buffer, the name of a process or buffer, or
6305 nil, indicating the current buffer's process.
6306 If PROCESS is a network connection, or is a process communicating
6307 through a pipe (as opposed to a pty), then you cannot send any more
6308 text to PROCESS after you call this function.
6309 If PROCESS is a serial process, wait until all output written to the
6310 process has been transmitted to the serial port. */)
6311 (Lisp_Object process
)
6314 struct coding_system
*coding
;
6316 if (DATAGRAM_CONN_P (process
))
6319 proc
= get_process (process
);
6320 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6322 /* Make sure the process is really alive. */
6323 if (XPROCESS (proc
)->raw_status_new
)
6324 update_status (XPROCESS (proc
));
6325 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6326 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6328 if (CODING_REQUIRE_FLUSHING (coding
))
6330 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6331 send_process (proc
, "", 0, Qnil
);
6334 if (XPROCESS (proc
)->pty_flag
)
6335 send_process (proc
, "\004", 1, Qnil
);
6336 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6339 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6340 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6341 #endif /* not WINDOWSNT */
6342 /* Do nothing on Windows because writes are blocking. */
6346 int old_outfd
, new_outfd
;
6348 #ifdef HAVE_SHUTDOWN
6349 /* If this is a network connection, or socketpair is used
6350 for communication with the subprocess, call shutdown to cause EOF.
6351 (In some old system, shutdown to socketpair doesn't work.
6352 Then we just can't win.) */
6353 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6354 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6355 shutdown (XPROCESS (proc
)->outfd
, 1);
6356 /* In case of socketpair, outfd == infd, so don't close it. */
6357 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6358 emacs_close (XPROCESS (proc
)->outfd
);
6359 #else /* not HAVE_SHUTDOWN */
6360 emacs_close (XPROCESS (proc
)->outfd
);
6361 #endif /* not HAVE_SHUTDOWN */
6362 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6365 old_outfd
= XPROCESS (proc
)->outfd
;
6367 if (!proc_encode_coding_system
[new_outfd
])
6368 proc_encode_coding_system
[new_outfd
]
6369 = xmalloc (sizeof (struct coding_system
));
6370 memcpy (proc_encode_coding_system
[new_outfd
],
6371 proc_encode_coding_system
[old_outfd
],
6372 sizeof (struct coding_system
));
6373 memset (proc_encode_coding_system
[old_outfd
], 0,
6374 sizeof (struct coding_system
));
6376 XPROCESS (proc
)->outfd
= new_outfd
;
6381 /* On receipt of a signal that a child status has changed, loop asking
6382 about children with changed statuses until the system says there
6385 All we do is change the status; we do not run sentinels or print
6386 notifications. That is saved for the next time keyboard input is
6387 done, in order to avoid timing errors.
6389 ** WARNING: this can be called during garbage collection.
6390 Therefore, it must not be fooled by the presence of mark bits in
6393 ** USG WARNING: Although it is not obvious from the documentation
6394 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6395 signal() before executing at least one wait(), otherwise the
6396 handler will be called again, resulting in an infinite loop. The
6397 relevant portion of the documentation reads "SIGCLD signals will be
6398 queued and the signal-catching function will be continually
6399 reentered until the queue is empty". Invoking signal() causes the
6400 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6403 ** Malloc WARNING: This should never call malloc either directly or
6404 indirectly; if it does, that is a bug */
6408 /* Record one child's changed status. Return true if a child was found. */
6410 record_child_status_change (void)
6413 struct Lisp_Process
*p
;
6419 pid
= waitpid (-1, &w
, WNOHANG
| WUNTRACED
);
6420 while (pid
< 0 && errno
== EINTR
);
6422 /* PID == 0 means no processes found, PID == -1 means a real failure.
6423 Either way, we have done all our job. */
6427 /* Find the process that signaled us, and record its status. */
6429 /* The process can have been deleted by Fdelete_process. */
6430 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6432 Lisp_Object xpid
= XCAR (tail
);
6433 if ((INTEGERP (xpid
) && pid
== XINT (xpid
))
6434 || (FLOATP (xpid
) && pid
== XFLOAT_DATA (xpid
)))
6436 XSETCAR (tail
, Qnil
);
6441 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6443 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6445 proc
= XCDR (XCAR (tail
));
6446 p
= XPROCESS (proc
);
6447 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6452 /* Look for an asynchronous process whose pid hasn't been filled
6455 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6457 proc
= XCDR (XCAR (tail
));
6458 p
= XPROCESS (proc
);
6464 /* Change the status of the process that was found. */
6467 int clear_desc_flag
= 0;
6469 p
->tick
= ++process_tick
;
6471 p
->raw_status_new
= 1;
6473 /* If process has terminated, stop waiting for its output. */
6474 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6476 clear_desc_flag
= 1;
6478 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6479 if (clear_desc_flag
)
6481 FD_CLR (p
->infd
, &input_wait_mask
);
6482 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6485 /* Tell wait_reading_process_output that it needs to wake up and
6487 if (input_available_clear_time
)
6488 *input_available_clear_time
= make_emacs_time (0, 0);
6490 /* There was no asynchronous process found for that pid: we have
6491 a synchronous process. */
6494 synch_process_alive
= 0;
6496 /* Report the status of the synchronous process. */
6498 synch_process_retcode
= WEXITSTATUS (w
);
6499 else if (WIFSIGNALED (w
))
6500 synch_process_termsig
= WTERMSIG (w
);
6502 /* Tell wait_reading_process_output that it needs to wake up and
6504 if (input_available_clear_time
)
6505 *input_available_clear_time
= make_emacs_time (0, 0);
6511 /* On some systems, the SIGCHLD handler must return right away. If
6512 any more processes want to signal us, we will get another signal.
6513 Otherwise, loop around to use up all the processes that have
6514 something to tell us. */
6515 #if (defined WINDOWSNT \
6516 || (defined USG && !defined GNU_LINUX \
6517 && !(defined HPUX && defined WNOHANG)))
6518 enum { CAN_HANDLE_MULTIPLE_CHILDREN
= 0 };
6520 enum { CAN_HANDLE_MULTIPLE_CHILDREN
= 1 };
6524 handle_child_signal (int sig
)
6526 while (record_child_status_change () && CAN_HANDLE_MULTIPLE_CHILDREN
)
6531 deliver_child_signal (int sig
)
6533 handle_on_main_thread (sig
, handle_child_signal
);
6536 #endif /* SIGCHLD */
6540 exec_sentinel_unwind (Lisp_Object data
)
6542 pset_sentinel (XPROCESS (XCAR (data
)), XCDR (data
));
6547 exec_sentinel_error_handler (Lisp_Object error_val
)
6549 cmd_error_internal (error_val
, "error in process sentinel: ");
6551 update_echo_area ();
6552 Fsleep_for (make_number (2), Qnil
);
6557 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6559 Lisp_Object sentinel
, odeactivate
;
6560 struct Lisp_Process
*p
= XPROCESS (proc
);
6561 ptrdiff_t count
= SPECPDL_INDEX ();
6562 bool outer_running_asynch_code
= running_asynch_code
;
6563 int waiting
= waiting_for_user_input_p
;
6565 if (inhibit_sentinels
)
6568 /* No need to gcpro these, because all we do with them later
6569 is test them for EQness, and none of them should be a string. */
6570 odeactivate
= Vdeactivate_mark
;
6572 Lisp_Object obuffer
, okeymap
;
6573 XSETBUFFER (obuffer
, current_buffer
);
6574 okeymap
= BVAR (current_buffer
, keymap
);
6577 /* There's no good reason to let sentinels change the current
6578 buffer, and many callers of accept-process-output, sit-for, and
6579 friends don't expect current-buffer to be changed from under them. */
6580 record_unwind_current_buffer ();
6582 sentinel
= p
->sentinel
;
6583 if (NILP (sentinel
))
6586 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6587 assure that it gets restored no matter how the sentinel exits. */
6588 pset_sentinel (p
, Qnil
);
6589 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6590 /* Inhibit quit so that random quits don't screw up a running filter. */
6591 specbind (Qinhibit_quit
, Qt
);
6592 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6594 /* In case we get recursively called,
6595 and we already saved the match data nonrecursively,
6596 save the same match data in safely recursive fashion. */
6597 if (outer_running_asynch_code
)
6600 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6601 restore_search_regs ();
6602 record_unwind_save_match_data ();
6603 Fset_match_data (tem
, Qt
);
6606 /* For speed, if a search happens within this code,
6607 save the match data in a special nonrecursive fashion. */
6608 running_asynch_code
= 1;
6610 internal_condition_case_1 (read_process_output_call
,
6612 Fcons (proc
, Fcons (reason
, Qnil
))),
6613 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6614 exec_sentinel_error_handler
);
6616 /* If we saved the match data nonrecursively, restore it now. */
6617 restore_search_regs ();
6618 running_asynch_code
= outer_running_asynch_code
;
6620 Vdeactivate_mark
= odeactivate
;
6622 /* Restore waiting_for_user_input_p as it was
6623 when we were called, in case the filter clobbered it. */
6624 waiting_for_user_input_p
= waiting
;
6627 if (! EQ (Fcurrent_buffer (), obuffer
)
6628 || ! EQ (current_buffer
->keymap
, okeymap
))
6630 /* But do it only if the caller is actually going to read events.
6631 Otherwise there's no need to make him wake up, and it could
6632 cause trouble (for example it would make sit_for return). */
6633 if (waiting_for_user_input_p
== -1)
6634 record_asynch_buffer_change ();
6636 unbind_to (count
, Qnil
);
6639 /* Report all recent events of a change in process status
6640 (either run the sentinel or output a message).
6641 This is usually done while Emacs is waiting for keyboard input
6642 but can be done at other times. */
6645 status_notify (struct Lisp_Process
*deleting_process
)
6647 register Lisp_Object proc
, buffer
;
6648 Lisp_Object tail
, msg
;
6649 struct gcpro gcpro1
, gcpro2
;
6653 /* We need to gcpro tail; if read_process_output calls a filter
6654 which deletes a process and removes the cons to which tail points
6655 from Vprocess_alist, and then causes a GC, tail is an unprotected
6659 /* Set this now, so that if new processes are created by sentinels
6660 that we run, we get called again to handle their status changes. */
6661 update_tick
= process_tick
;
6663 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6666 register struct Lisp_Process
*p
;
6668 proc
= Fcdr (XCAR (tail
));
6669 p
= XPROCESS (proc
);
6671 if (p
->tick
!= p
->update_tick
)
6673 p
->update_tick
= p
->tick
;
6675 /* If process is still active, read any output that remains. */
6676 while (! EQ (p
->filter
, Qt
)
6677 && ! EQ (p
->status
, Qconnect
)
6678 && ! EQ (p
->status
, Qlisten
)
6679 /* Network or serial process not stopped: */
6680 && ! EQ (p
->command
, Qt
)
6682 && p
!= deleting_process
6683 && read_process_output (proc
, p
->infd
) > 0);
6687 /* Get the text to use for the message. */
6688 if (p
->raw_status_new
)
6690 msg
= status_message (p
);
6692 /* If process is terminated, deactivate it or delete it. */
6694 if (CONSP (p
->status
))
6695 symbol
= XCAR (p
->status
);
6697 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6698 || EQ (symbol
, Qclosed
))
6700 if (delete_exited_processes
)
6701 remove_process (proc
);
6703 deactivate_process (proc
);
6706 /* The actions above may have further incremented p->tick.
6707 So set p->update_tick again
6708 so that an error in the sentinel will not cause
6709 this code to be run again. */
6710 p
->update_tick
= p
->tick
;
6711 /* Now output the message suitably. */
6712 if (!NILP (p
->sentinel
))
6713 exec_sentinel (proc
, msg
);
6714 /* Don't bother with a message in the buffer
6715 when a process becomes runnable. */
6716 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6719 struct buffer
*old
= current_buffer
;
6720 ptrdiff_t opoint
, opoint_byte
;
6721 ptrdiff_t before
, before_byte
;
6723 /* Avoid error if buffer is deleted
6724 (probably that's why the process is dead, too) */
6725 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
6727 Fset_buffer (buffer
);
6730 opoint_byte
= PT_BYTE
;
6731 /* Insert new output into buffer
6732 at the current end-of-output marker,
6733 thus preserving logical ordering of input and output. */
6734 if (XMARKER (p
->mark
)->buffer
)
6735 Fgoto_char (p
->mark
);
6737 SET_PT_BOTH (ZV
, ZV_BYTE
);
6740 before_byte
= PT_BYTE
;
6742 tem
= BVAR (current_buffer
, read_only
);
6743 bset_read_only (current_buffer
, Qnil
);
6744 insert_string ("\nProcess ");
6745 { /* FIXME: temporary kludge */
6746 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
6747 insert_string (" ");
6749 bset_read_only (current_buffer
, tem
);
6750 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6752 if (opoint
>= before
)
6753 SET_PT_BOTH (opoint
+ (PT
- before
),
6754 opoint_byte
+ (PT_BYTE
- before_byte
));
6756 SET_PT_BOTH (opoint
, opoint_byte
);
6758 set_buffer_internal (old
);
6763 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6768 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6769 Sset_process_coding_system
, 1, 3, 0,
6770 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6771 DECODING will be used to decode subprocess output and ENCODING to
6772 encode subprocess input. */)
6773 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6775 register struct Lisp_Process
*p
;
6777 CHECK_PROCESS (process
);
6778 p
= XPROCESS (process
);
6780 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6782 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6783 Fcheck_coding_system (decoding
);
6784 Fcheck_coding_system (encoding
);
6785 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6786 pset_decode_coding_system (p
, decoding
);
6787 pset_encode_coding_system (p
, encoding
);
6788 setup_process_coding_systems (process
);
6793 DEFUN ("process-coding-system",
6794 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6795 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6796 (register Lisp_Object process
)
6798 CHECK_PROCESS (process
);
6799 return Fcons (XPROCESS (process
)->decode_coding_system
,
6800 XPROCESS (process
)->encode_coding_system
);
6803 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6804 Sset_process_filter_multibyte
, 2, 2, 0,
6805 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6806 If FLAG is non-nil, the filter is given multibyte strings.
6807 If FLAG is nil, the filter is given unibyte strings. In this case,
6808 all character code conversion except for end-of-line conversion is
6810 (Lisp_Object process
, Lisp_Object flag
)
6812 register struct Lisp_Process
*p
;
6814 CHECK_PROCESS (process
);
6815 p
= XPROCESS (process
);
6817 pset_decode_coding_system
6818 (p
, raw_text_coding_system (p
->decode_coding_system
));
6819 setup_process_coding_systems (process
);
6824 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6825 Sprocess_filter_multibyte_p
, 1, 1, 0,
6826 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6827 (Lisp_Object process
)
6829 register struct Lisp_Process
*p
;
6830 struct coding_system
*coding
;
6832 CHECK_PROCESS (process
);
6833 p
= XPROCESS (process
);
6834 coding
= proc_decode_coding_system
[p
->infd
];
6835 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6844 add_gpm_wait_descriptor (int desc
)
6846 add_keyboard_wait_descriptor (desc
);
6850 delete_gpm_wait_descriptor (int desc
)
6852 delete_keyboard_wait_descriptor (desc
);
6859 /* Return nonzero if *MASK has a bit set
6860 that corresponds to one of the keyboard input descriptors. */
6863 keyboard_bit_set (fd_set
*mask
)
6867 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6868 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6869 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6876 #else /* not subprocesses */
6878 /* Defined on msdos.c. */
6879 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6880 EMACS_TIME
*, void *);
6882 /* Implementation of wait_reading_process_output, assuming that there
6883 are no subprocesses. Used only by the MS-DOS build.
6885 Wait for timeout to elapse and/or keyboard input to be available.
6889 If negative, gobble data immediately available but don't wait for any.
6892 an additional duration to wait, measured in nanoseconds
6893 If TIME_LIMIT is zero, then:
6894 If NSECS == 0, there is no limit.
6895 If NSECS > 0, the timeout consists of NSECS only.
6896 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
6899 0 to ignore keyboard input, or
6900 1 to return when input is available, or
6901 -1 means caller will actually read the input, so don't throw to
6904 see full version for other parameters. We know that wait_proc will
6905 always be NULL, since `subprocesses' isn't defined.
6907 DO_DISPLAY != 0 means redisplay should be done to show subprocess
6908 output that arrives.
6910 Return true if we received input from any process. */
6913 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
6915 Lisp_Object wait_for_cell
,
6916 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6919 EMACS_TIME end_time
, timeout
;
6926 else if (TYPE_MAXIMUM (time_t) < time_limit
)
6927 time_limit
= TYPE_MAXIMUM (time_t);
6929 /* What does time_limit really mean? */
6930 if (time_limit
|| 0 < nsecs
)
6932 timeout
= make_emacs_time (time_limit
, nsecs
);
6933 end_time
= add_emacs_time (current_emacs_time (), timeout
);
6936 /* Turn off periodic alarms (in case they are in use)
6937 and then turn off any other atimers,
6938 because the select emulator uses alarms. */
6940 turn_on_atimers (0);
6944 int timeout_reduced_for_timers
= 0;
6945 SELECT_TYPE waitchannels
;
6948 /* If calling from keyboard input, do not quit
6949 since we want to return C-g as an input character.
6950 Otherwise, do pending quit if requested. */
6954 /* Exit now if the cell we're waiting for became non-nil. */
6955 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6958 /* Compute time from now till when time limit is up */
6959 /* Exit if already run out */
6962 /* A negative timeout means
6963 gobble output available now
6964 but don't wait at all. */
6966 timeout
= make_emacs_time (0, 0);
6968 else if (time_limit
|| 0 < nsecs
)
6970 EMACS_TIME now
= current_emacs_time ();
6971 if (EMACS_TIME_LE (end_time
, now
))
6973 timeout
= sub_emacs_time (end_time
, now
);
6977 timeout
= make_emacs_time (100000, 0);
6980 /* If our caller will not immediately handle keyboard events,
6981 run timer events directly.
6982 (Callers that will immediately read keyboard events
6983 call timer_delay on their own.) */
6984 if (NILP (wait_for_cell
))
6986 EMACS_TIME timer_delay
;
6990 int old_timers_run
= timers_run
;
6991 timer_delay
= timer_check ();
6992 if (timers_run
!= old_timers_run
&& do_display
)
6993 /* We must retry, since a timer may have requeued itself
6994 and that could alter the time delay. */
6995 redisplay_preserve_echo_area (14);
6999 while (!detect_input_pending ());
7001 /* If there is unread keyboard input, also return. */
7003 && requeued_events_pending_p ())
7006 if (EMACS_TIME_VALID_P (timer_delay
) && 0 <= nsecs
)
7008 if (EMACS_TIME_LT (timer_delay
, timeout
))
7010 timeout
= timer_delay
;
7011 timeout_reduced_for_timers
= 1;
7016 /* Cause C-g and alarm signals to take immediate action,
7017 and cause input available signals to zero out timeout. */
7019 set_waiting_for_input (&timeout
);
7021 /* If a frame has been newly mapped and needs updating,
7022 reprocess its display stuff. */
7023 if (frame_garbaged
&& do_display
)
7025 clear_waiting_for_input ();
7026 redisplay_preserve_echo_area (15);
7028 set_waiting_for_input (&timeout
);
7031 /* Wait till there is something to do. */
7032 FD_ZERO (&waitchannels
);
7033 if (read_kbd
&& detect_input_pending ())
7037 if (read_kbd
|| !NILP (wait_for_cell
))
7038 FD_SET (0, &waitchannels
);
7039 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
7044 /* Make C-g and alarm signals set flags again */
7045 clear_waiting_for_input ();
7047 /* If we woke up due to SIGWINCH, actually change size now. */
7048 do_pending_window_change (0);
7050 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
7051 /* We waited the full specified time, so return now. */
7056 /* If the system call was interrupted, then go around the
7058 if (xerrno
== EINTR
)
7059 FD_ZERO (&waitchannels
);
7061 error ("select error: %s", emacs_strerror (xerrno
));
7064 /* Check for keyboard input */
7067 && detect_input_pending_run_timers (do_display
))
7069 swallow_events (do_display
);
7070 if (detect_input_pending_run_timers (do_display
))
7074 /* If there is unread keyboard input, also return. */
7076 && requeued_events_pending_p ())
7079 /* If wait_for_cell. check for keyboard input
7080 but don't run any timers.
7081 ??? (It seems wrong to me to check for keyboard
7082 input at all when wait_for_cell, but the code
7083 has been this way since July 1994.
7084 Try changing this after version 19.31.) */
7085 if (! NILP (wait_for_cell
)
7086 && detect_input_pending ())
7088 swallow_events (do_display
);
7089 if (detect_input_pending ())
7093 /* Exit now if the cell we're waiting for became non-nil. */
7094 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7103 #endif /* not subprocesses */
7105 /* The following functions are needed even if async subprocesses are
7106 not supported. Some of them are no-op stubs in that case. */
7108 /* Add DESC to the set of keyboard input descriptors. */
7111 add_keyboard_wait_descriptor (int desc
)
7113 #ifdef subprocesses /* actually means "not MSDOS" */
7114 FD_SET (desc
, &input_wait_mask
);
7115 FD_SET (desc
, &non_process_wait_mask
);
7116 if (desc
> max_input_desc
)
7117 max_input_desc
= desc
;
7121 /* From now on, do not expect DESC to give keyboard input. */
7124 delete_keyboard_wait_descriptor (int desc
)
7128 int lim
= max_input_desc
;
7130 FD_CLR (desc
, &input_wait_mask
);
7131 FD_CLR (desc
, &non_process_wait_mask
);
7133 if (desc
== max_input_desc
)
7134 for (fd
= 0; fd
< lim
; fd
++)
7135 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
7136 max_input_desc
= fd
;
7140 /* Setup coding systems of PROCESS. */
7143 setup_process_coding_systems (Lisp_Object process
)
7146 struct Lisp_Process
*p
= XPROCESS (process
);
7148 int outch
= p
->outfd
;
7149 Lisp_Object coding_system
;
7151 if (inch
< 0 || outch
< 0)
7154 if (!proc_decode_coding_system
[inch
])
7155 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7156 coding_system
= p
->decode_coding_system
;
7157 if (! NILP (p
->filter
))
7159 else if (BUFFERP (p
->buffer
))
7161 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7162 coding_system
= raw_text_coding_system (coding_system
);
7164 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7166 if (!proc_encode_coding_system
[outch
])
7167 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7168 setup_coding_system (p
->encode_coding_system
,
7169 proc_encode_coding_system
[outch
]);
7173 /* Close all descriptors currently in use for communication
7174 with subprocess. This is used in a newly-forked subprocess
7175 to get rid of irrelevant descriptors. */
7178 close_process_descs (void)
7182 for (i
= 0; i
< MAXDESC
; i
++)
7184 Lisp_Object process
;
7185 process
= chan_process
[i
];
7186 if (!NILP (process
))
7188 int in
= XPROCESS (process
)->infd
;
7189 int out
= XPROCESS (process
)->outfd
;
7192 if (out
>= 0 && in
!= out
)
7199 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7200 doc
: /* Return the (or a) process associated with BUFFER.
7201 BUFFER may be a buffer or the name of one. */)
7202 (register Lisp_Object buffer
)
7205 register Lisp_Object buf
, tail
, proc
;
7207 if (NILP (buffer
)) return Qnil
;
7208 buf
= Fget_buffer (buffer
);
7209 if (NILP (buf
)) return Qnil
;
7211 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7213 proc
= Fcdr (XCAR (tail
));
7214 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
7217 #endif /* subprocesses */
7221 DEFUN ("process-inherit-coding-system-flag",
7222 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7224 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7225 If this flag is t, `buffer-file-coding-system' of the buffer
7226 associated with PROCESS will inherit the coding system used to decode
7227 the process output. */)
7228 (register Lisp_Object process
)
7231 CHECK_PROCESS (process
);
7232 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7234 /* Ignore the argument and return the value of
7235 inherit-process-coding-system. */
7236 return inherit_process_coding_system
? Qt
: Qnil
;
7240 /* Kill all processes associated with `buffer'.
7241 If `buffer' is nil, kill all processes */
7244 kill_buffer_processes (Lisp_Object buffer
)
7247 Lisp_Object tail
, proc
;
7249 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7251 proc
= XCDR (XCAR (tail
));
7253 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
7255 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
7256 Fdelete_process (proc
);
7257 else if (XPROCESS (proc
)->infd
>= 0)
7258 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7261 #else /* subprocesses */
7262 /* Since we have no subprocesses, this does nothing. */
7263 #endif /* subprocesses */
7266 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7267 Swaiting_for_user_input_p
, 0, 0, 0,
7268 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
7269 This is intended for use by asynchronous process output filters and sentinels. */)
7273 return (waiting_for_user_input_p
? Qt
: Qnil
);
7279 /* Stop reading input from keyboard sources. */
7282 hold_keyboard_input (void)
7287 /* Resume reading input from keyboard sources. */
7290 unhold_keyboard_input (void)
7295 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7298 kbd_on_hold_p (void)
7300 return kbd_is_on_hold
;
7304 /* Enumeration of and access to system processes a-la ps(1). */
7306 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7308 doc
: /* Return a list of numerical process IDs of all running processes.
7309 If this functionality is unsupported, return nil.
7311 See `process-attributes' for getting attributes of a process given its ID. */)
7314 return list_system_processes ();
7317 DEFUN ("process-attributes", Fprocess_attributes
,
7318 Sprocess_attributes
, 1, 1, 0,
7319 doc
: /* Return attributes of the process given by its PID, a number.
7321 Value is an alist where each element is a cons cell of the form
7325 If this functionality is unsupported, the value is nil.
7327 See `list-system-processes' for getting a list of all process IDs.
7329 The KEYs of the attributes that this function may return are listed
7330 below, together with the type of the associated VALUE (in parentheses).
7331 Not all platforms support all of these attributes; unsupported
7332 attributes will not appear in the returned alist.
7333 Unless explicitly indicated otherwise, numbers can have either
7334 integer or floating point values.
7336 euid -- Effective user User ID of the process (number)
7337 user -- User name corresponding to euid (string)
7338 egid -- Effective user Group ID of the process (number)
7339 group -- Group name corresponding to egid (string)
7340 comm -- Command name (executable name only) (string)
7341 state -- Process state code, such as "S", "R", or "T" (string)
7342 ppid -- Parent process ID (number)
7343 pgrp -- Process group ID (number)
7344 sess -- Session ID, i.e. process ID of session leader (number)
7345 ttname -- Controlling tty name (string)
7346 tpgid -- ID of foreground process group on the process's tty (number)
7347 minflt -- number of minor page faults (number)
7348 majflt -- number of major page faults (number)
7349 cminflt -- cumulative number of minor page faults (number)
7350 cmajflt -- cumulative number of major page faults (number)
7351 utime -- user time used by the process, in (current-time) format,
7352 which is a list of integers (HIGH LOW USEC PSEC)
7353 stime -- system time used by the process (current-time)
7354 time -- sum of utime and stime (current-time)
7355 cutime -- user time used by the process and its children (current-time)
7356 cstime -- system time used by the process and its children (current-time)
7357 ctime -- sum of cutime and cstime (current-time)
7358 pri -- priority of the process (number)
7359 nice -- nice value of the process (number)
7360 thcount -- process thread count (number)
7361 start -- time the process started (current-time)
7362 vsize -- virtual memory size of the process in KB's (number)
7363 rss -- resident set size of the process in KB's (number)
7364 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7365 pcpu -- percents of CPU time used by the process (floating-point number)
7366 pmem -- percents of total physical memory used by process's resident set
7367 (floating-point number)
7368 args -- command line which invoked the process (string). */)
7371 return system_process_attributes (pid
);
7375 /* This is not called "init_process" because that is the name of a
7376 Mach system call, so it would cause problems on Darwin systems. */
7378 init_process_emacs (void)
7383 inhibit_sentinels
= 0;
7387 if (! noninteractive
|| initialized
)
7390 struct sigaction action
;
7391 emacs_sigaction_init (&action
, deliver_child_signal
);
7392 sigaction (SIGCHLD
, &action
, 0);
7396 FD_ZERO (&input_wait_mask
);
7397 FD_ZERO (&non_keyboard_wait_mask
);
7398 FD_ZERO (&non_process_wait_mask
);
7399 FD_ZERO (&write_mask
);
7400 max_process_desc
= 0;
7401 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7403 #ifdef NON_BLOCKING_CONNECT
7404 FD_ZERO (&connect_wait_mask
);
7405 num_pending_connects
= 0;
7408 #ifdef ADAPTIVE_READ_BUFFERING
7409 process_output_delay_count
= 0;
7410 process_output_skip
= 0;
7413 /* Don't do this, it caused infinite select loops. The display
7414 method should call add_keyboard_wait_descriptor on stdin if it
7417 FD_SET (0, &input_wait_mask
);
7420 Vprocess_alist
= Qnil
;
7422 deleted_pid_list
= Qnil
;
7424 for (i
= 0; i
< MAXDESC
; i
++)
7426 chan_process
[i
] = Qnil
;
7427 proc_buffered_char
[i
] = -1;
7429 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7430 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7431 #ifdef DATAGRAM_SOCKETS
7432 memset (datagram_address
, 0, sizeof datagram_address
);
7436 Lisp_Object subfeatures
= Qnil
;
7437 const struct socket_options
*sopt
;
7439 #define ADD_SUBFEATURE(key, val) \
7440 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7442 #ifdef NON_BLOCKING_CONNECT
7443 ADD_SUBFEATURE (QCnowait
, Qt
);
7445 #ifdef DATAGRAM_SOCKETS
7446 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7448 #ifdef HAVE_SEQPACKET
7449 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7451 #ifdef HAVE_LOCAL_SOCKETS
7452 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7454 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7456 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7458 #ifdef HAVE_GETSOCKNAME
7459 ADD_SUBFEATURE (QCservice
, Qt
);
7461 #if defined (O_NONBLOCK) || defined (O_NDELAY)
7462 ADD_SUBFEATURE (QCserver
, Qt
);
7465 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7466 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7468 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7471 #if defined (DARWIN_OS)
7472 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7473 processes. As such, we only change the default value. */
7476 char const *release
= (STRINGP (Voperating_system_release
)
7477 ? SSDATA (Voperating_system_release
)
7479 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
7480 Vprocess_connection_type
= Qnil
;
7484 #endif /* subprocesses */
7489 syms_of_process (void)
7493 DEFSYM (Qprocessp
, "processp");
7494 DEFSYM (Qrun
, "run");
7495 DEFSYM (Qstop
, "stop");
7496 DEFSYM (Qsignal
, "signal");
7498 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7501 Qexit = intern_c_string ("exit");
7502 staticpro (&Qexit); */
7504 DEFSYM (Qopen
, "open");
7505 DEFSYM (Qclosed
, "closed");
7506 DEFSYM (Qconnect
, "connect");
7507 DEFSYM (Qfailed
, "failed");
7508 DEFSYM (Qlisten
, "listen");
7509 DEFSYM (Qlocal
, "local");
7510 DEFSYM (Qipv4
, "ipv4");
7512 DEFSYM (Qipv6
, "ipv6");
7514 DEFSYM (Qdatagram
, "datagram");
7515 DEFSYM (Qseqpacket
, "seqpacket");
7517 DEFSYM (QCport
, ":port");
7518 DEFSYM (QCspeed
, ":speed");
7519 DEFSYM (QCprocess
, ":process");
7521 DEFSYM (QCbytesize
, ":bytesize");
7522 DEFSYM (QCstopbits
, ":stopbits");
7523 DEFSYM (QCparity
, ":parity");
7524 DEFSYM (Qodd
, "odd");
7525 DEFSYM (Qeven
, "even");
7526 DEFSYM (QCflowcontrol
, ":flowcontrol");
7529 DEFSYM (QCsummary
, ":summary");
7531 DEFSYM (Qreal
, "real");
7532 DEFSYM (Qnetwork
, "network");
7533 DEFSYM (Qserial
, "serial");
7534 DEFSYM (QCbuffer
, ":buffer");
7535 DEFSYM (QChost
, ":host");
7536 DEFSYM (QCservice
, ":service");
7537 DEFSYM (QClocal
, ":local");
7538 DEFSYM (QCremote
, ":remote");
7539 DEFSYM (QCcoding
, ":coding");
7540 DEFSYM (QCserver
, ":server");
7541 DEFSYM (QCnowait
, ":nowait");
7542 DEFSYM (QCsentinel
, ":sentinel");
7543 DEFSYM (QClog
, ":log");
7544 DEFSYM (QCnoquery
, ":noquery");
7545 DEFSYM (QCstop
, ":stop");
7546 DEFSYM (QCoptions
, ":options");
7547 DEFSYM (QCplist
, ":plist");
7549 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
7551 staticpro (&Vprocess_alist
);
7553 staticpro (&deleted_pid_list
);
7556 #endif /* subprocesses */
7558 DEFSYM (QCname
, ":name");
7559 DEFSYM (QCtype
, ":type");
7561 DEFSYM (Qeuid
, "euid");
7562 DEFSYM (Qegid
, "egid");
7563 DEFSYM (Quser
, "user");
7564 DEFSYM (Qgroup
, "group");
7565 DEFSYM (Qcomm
, "comm");
7566 DEFSYM (Qstate
, "state");
7567 DEFSYM (Qppid
, "ppid");
7568 DEFSYM (Qpgrp
, "pgrp");
7569 DEFSYM (Qsess
, "sess");
7570 DEFSYM (Qttname
, "ttname");
7571 DEFSYM (Qtpgid
, "tpgid");
7572 DEFSYM (Qminflt
, "minflt");
7573 DEFSYM (Qmajflt
, "majflt");
7574 DEFSYM (Qcminflt
, "cminflt");
7575 DEFSYM (Qcmajflt
, "cmajflt");
7576 DEFSYM (Qutime
, "utime");
7577 DEFSYM (Qstime
, "stime");
7578 DEFSYM (Qtime
, "time");
7579 DEFSYM (Qcutime
, "cutime");
7580 DEFSYM (Qcstime
, "cstime");
7581 DEFSYM (Qctime
, "ctime");
7582 DEFSYM (Qpri
, "pri");
7583 DEFSYM (Qnice
, "nice");
7584 DEFSYM (Qthcount
, "thcount");
7585 DEFSYM (Qstart
, "start");
7586 DEFSYM (Qvsize
, "vsize");
7587 DEFSYM (Qrss
, "rss");
7588 DEFSYM (Qetime
, "etime");
7589 DEFSYM (Qpcpu
, "pcpu");
7590 DEFSYM (Qpmem
, "pmem");
7591 DEFSYM (Qargs
, "args");
7593 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7594 doc
: /* Non-nil means delete processes immediately when they exit.
7595 A value of nil means don't delete them until `list-processes' is run. */);
7597 delete_exited_processes
= 1;
7600 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7601 doc
: /* Control type of device used to communicate with subprocesses.
7602 Values are nil to use a pipe, or t or `pty' to use a pty.
7603 The value has no effect if the system has no ptys or if all ptys are busy:
7604 then a pipe is used in any case.
7605 The value takes effect when `start-process' is called. */);
7606 Vprocess_connection_type
= Qt
;
7608 #ifdef ADAPTIVE_READ_BUFFERING
7609 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7610 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7611 On some systems, when Emacs reads the output from a subprocess, the output data
7612 is read in very small blocks, potentially resulting in very poor performance.
7613 This behavior can be remedied to some extent by setting this variable to a
7614 non-nil value, as it will automatically delay reading from such processes, to
7615 allow them to produce more output before Emacs tries to read it.
7616 If the value is t, the delay is reset after each write to the process; any other
7617 non-nil value means that the delay is not reset on write.
7618 The variable takes effect when `start-process' is called. */);
7619 Vprocess_adaptive_read_buffering
= Qt
;
7622 defsubr (&Sprocessp
);
7623 defsubr (&Sget_process
);
7624 defsubr (&Sdelete_process
);
7625 defsubr (&Sprocess_status
);
7626 defsubr (&Sprocess_exit_status
);
7627 defsubr (&Sprocess_id
);
7628 defsubr (&Sprocess_name
);
7629 defsubr (&Sprocess_tty_name
);
7630 defsubr (&Sprocess_command
);
7631 defsubr (&Sset_process_buffer
);
7632 defsubr (&Sprocess_buffer
);
7633 defsubr (&Sprocess_mark
);
7634 defsubr (&Sset_process_filter
);
7635 defsubr (&Sprocess_filter
);
7636 defsubr (&Sset_process_sentinel
);
7637 defsubr (&Sprocess_sentinel
);
7638 defsubr (&Sset_process_window_size
);
7639 defsubr (&Sset_process_inherit_coding_system_flag
);
7640 defsubr (&Sset_process_query_on_exit_flag
);
7641 defsubr (&Sprocess_query_on_exit_flag
);
7642 defsubr (&Sprocess_contact
);
7643 defsubr (&Sprocess_plist
);
7644 defsubr (&Sset_process_plist
);
7645 defsubr (&Sprocess_list
);
7646 defsubr (&Sstart_process
);
7647 defsubr (&Sserial_process_configure
);
7648 defsubr (&Smake_serial_process
);
7649 defsubr (&Sset_network_process_option
);
7650 defsubr (&Smake_network_process
);
7651 defsubr (&Sformat_network_address
);
7652 #if defined (HAVE_NET_IF_H)
7654 defsubr (&Snetwork_interface_list
);
7656 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
7657 defsubr (&Snetwork_interface_info
);
7659 #endif /* defined (HAVE_NET_IF_H) */
7660 #ifdef DATAGRAM_SOCKETS
7661 defsubr (&Sprocess_datagram_address
);
7662 defsubr (&Sset_process_datagram_address
);
7664 defsubr (&Saccept_process_output
);
7665 defsubr (&Sprocess_send_region
);
7666 defsubr (&Sprocess_send_string
);
7667 defsubr (&Sinterrupt_process
);
7668 defsubr (&Skill_process
);
7669 defsubr (&Squit_process
);
7670 defsubr (&Sstop_process
);
7671 defsubr (&Scontinue_process
);
7672 defsubr (&Sprocess_running_child_p
);
7673 defsubr (&Sprocess_send_eof
);
7674 defsubr (&Ssignal_process
);
7675 defsubr (&Swaiting_for_user_input_p
);
7676 defsubr (&Sprocess_type
);
7677 defsubr (&Sset_process_coding_system
);
7678 defsubr (&Sprocess_coding_system
);
7679 defsubr (&Sset_process_filter_multibyte
);
7680 defsubr (&Sprocess_filter_multibyte_p
);
7682 #endif /* subprocesses */
7684 defsubr (&Sget_buffer_process
);
7685 defsubr (&Sprocess_inherit_coding_system_flag
);
7686 defsubr (&Slist_system_processes
);
7687 defsubr (&Sprocess_attributes
);