American English spelling fix.
[bpt/emacs.git] / src / process.c
1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
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.
12
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.
17
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/>. */
20
21
22 #include <config.h>
23 #include <signal.h>
24
25 /* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
31
32 \f
33 #ifdef subprocesses
34
35 #include <stdio.h>
36 #include <errno.h>
37 #include <setjmp.h>
38 #include <sys/types.h> /* some typedefs are used in sys/file.h */
39 #include <sys/file.h>
40 #include <sys/stat.h>
41 #ifdef HAVE_INTTYPES_H
42 #include <inttypes.h>
43 #endif
44 #ifdef HAVE_UNISTD_H
45 #include <unistd.h>
46 #endif
47
48 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
49 #include <stdlib.h>
50 #include <fcntl.h>
51 #endif /* not WINDOWSNT */
52
53 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
54 #include <sys/socket.h>
55 #include <netdb.h>
56 #include <netinet/in.h>
57 #include <arpa/inet.h>
58
59 /* Are local (unix) sockets supported? */
60 #if defined (HAVE_SYS_UN_H)
61 #if !defined (AF_LOCAL) && defined (AF_UNIX)
62 #define AF_LOCAL AF_UNIX
63 #endif
64 #ifdef AF_LOCAL
65 #define HAVE_LOCAL_SOCKETS
66 #include <sys/un.h>
67 #endif
68 #endif
69 #endif /* HAVE_SOCKETS */
70
71 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
72 #ifdef TERM
73 #include <client.h>
74 #endif
75
76 #if defined(BSD_SYSTEM)
77 #include <sys/ioctl.h>
78 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
79 #include <fcntl.h>
80 #endif /* HAVE_PTYS and no O_NDELAY */
81 #endif /* BSD_SYSTEM */
82
83 #ifdef NEED_BSDTTY
84 #include <bsdtty.h>
85 #endif
86
87 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
88 #ifdef HAVE_SOCKETS
89 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
90 /* sys/ioctl.h may have been included already */
91 #ifndef SIOCGIFADDR
92 #include <sys/ioctl.h>
93 #endif
94 #include <net/if.h>
95 #endif
96 #endif
97
98 #ifdef IRIS
99 #include <sys/sysmacros.h> /* for "minor" */
100 #endif /* not IRIS */
101
102 #ifdef HAVE_SYS_WAIT
103 #include <sys/wait.h>
104 #endif
105
106 #ifdef HAVE_RES_INIT
107 #include <netinet/in.h>
108 #include <arpa/nameser.h>
109 #include <resolv.h>
110 #endif
111
112 #include "lisp.h"
113 #include "systime.h"
114 #include "systty.h"
115
116 #include "window.h"
117 #include "buffer.h"
118 #include "character.h"
119 #include "coding.h"
120 #include "process.h"
121 #include "frame.h"
122 #include "termhooks.h"
123 #include "termopts.h"
124 #include "commands.h"
125 #include "keyboard.h"
126 #include "blockinput.h"
127 #include "dispextern.h"
128 #include "composite.h"
129 #include "atimer.h"
130
131 Lisp_Object Qprocessp;
132 Lisp_Object Qrun, Qstop, Qsignal;
133 Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
134 Lisp_Object Qlocal, Qipv4, Qdatagram;
135 Lisp_Object Qreal, Qnetwork, Qserial;
136 #ifdef AF_INET6
137 Lisp_Object Qipv6;
138 #endif
139 Lisp_Object QCport, QCspeed, QCprocess;
140 Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
141 Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
142 Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
143 Lisp_Object QClocal, QCremote, QCcoding;
144 Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
145 Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
146 Lisp_Object Qlast_nonmenu_event;
147 /* QCfamily is declared and initialized in xfaces.c,
148 QCfilter in keyboard.c. */
149 extern Lisp_Object QCfamily, QCfilter;
150
151 /* Qexit is declared and initialized in eval.c. */
152
153 /* QCfamily is defined in xfaces.c. */
154 extern Lisp_Object QCfamily;
155 /* QCfilter is defined in keyboard.c. */
156 extern Lisp_Object QCfilter;
157
158 #ifdef HAVE_SOCKETS
159 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
160 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
161 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
162 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
163 #else
164 #define NETCONN_P(p) 0
165 #define NETCONN1_P(p) 0
166 #define SERIALCONN_P(p) 0
167 #define SERIALCONN1_P(p) 0
168 #endif /* HAVE_SOCKETS */
169
170 /* Define first descriptor number available for subprocesses. */
171 #ifdef VMS
172 #define FIRST_PROC_DESC 1
173 #else /* Not VMS */
174 #define FIRST_PROC_DESC 3
175 #endif
176
177 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
178 testing SIGCHLD. */
179
180 #if !defined (SIGCHLD) && defined (SIGCLD)
181 #define SIGCHLD SIGCLD
182 #endif /* SIGCLD */
183
184 #include "syssignal.h"
185
186 #include "syswait.h"
187
188 extern char *get_operating_system_release ();
189
190 /* Serial processes require termios or Windows. */
191 #if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
192 #define HAVE_SERIAL
193 #endif
194
195 #ifdef HAVE_SERIAL
196 /* From sysdep.c or w32.c */
197 extern int serial_open (char *port);
198 extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
199 #endif
200
201 #ifndef USE_CRT_DLL
202 extern int errno;
203 #endif
204 #ifdef VMS
205 extern char *sys_errlist[];
206 #endif
207
208 #ifndef HAVE_H_ERRNO
209 extern int h_errno;
210 #endif
211
212 /* t means use pty, nil means use a pipe,
213 maybe other values to come. */
214 static Lisp_Object Vprocess_connection_type;
215
216 /* These next two vars are non-static since sysdep.c uses them in the
217 emulation of `select'. */
218 /* Number of events of change of status of a process. */
219 int process_tick;
220 /* Number of events for which the user or sentinel has been notified. */
221 int update_tick;
222
223 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
224
225 #ifdef BROKEN_NON_BLOCKING_CONNECT
226 #undef NON_BLOCKING_CONNECT
227 #else
228 #ifndef NON_BLOCKING_CONNECT
229 #ifdef HAVE_SOCKETS
230 #ifdef HAVE_SELECT
231 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
232 #if defined (O_NONBLOCK) || defined (O_NDELAY)
233 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
234 #define NON_BLOCKING_CONNECT
235 #endif /* EWOULDBLOCK || EINPROGRESS */
236 #endif /* O_NONBLOCK || O_NDELAY */
237 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
238 #endif /* HAVE_SELECT */
239 #endif /* HAVE_SOCKETS */
240 #endif /* NON_BLOCKING_CONNECT */
241 #endif /* BROKEN_NON_BLOCKING_CONNECT */
242
243 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
244 this system. We need to read full packets, so we need a
245 "non-destructive" select. So we require either native select,
246 or emulation of select using FIONREAD. */
247
248 #ifdef BROKEN_DATAGRAM_SOCKETS
249 #undef DATAGRAM_SOCKETS
250 #else
251 #ifndef DATAGRAM_SOCKETS
252 #ifdef HAVE_SOCKETS
253 #if defined (HAVE_SELECT) || defined (FIONREAD)
254 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
255 #define DATAGRAM_SOCKETS
256 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
257 #endif /* HAVE_SELECT || FIONREAD */
258 #endif /* HAVE_SOCKETS */
259 #endif /* DATAGRAM_SOCKETS */
260 #endif /* BROKEN_DATAGRAM_SOCKETS */
261
262 #ifdef TERM
263 #undef NON_BLOCKING_CONNECT
264 #undef DATAGRAM_SOCKETS
265 #endif
266
267 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
268 #ifdef EMACS_HAS_USECS
269 #define ADAPTIVE_READ_BUFFERING
270 #endif
271 #endif
272
273 #ifdef ADAPTIVE_READ_BUFFERING
274 #define READ_OUTPUT_DELAY_INCREMENT 10000
275 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
276 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
277
278 /* Number of processes which have a non-zero read_output_delay,
279 and therefore might be delayed for adaptive read buffering. */
280
281 static int process_output_delay_count;
282
283 /* Non-zero if any process has non-nil read_output_skip. */
284
285 static int process_output_skip;
286
287 /* Non-nil means to delay reading process output to improve buffering.
288 A value of t means that delay is reset after each send, any other
289 non-nil value does not reset the delay. A value of nil disables
290 adaptive read buffering completely. */
291 static Lisp_Object Vprocess_adaptive_read_buffering;
292 #else
293 #define process_output_delay_count 0
294 #endif
295
296
297 #include "sysselect.h"
298
299 static int keyboard_bit_set P_ ((SELECT_TYPE *));
300 static void deactivate_process P_ ((Lisp_Object));
301 static void status_notify P_ ((struct Lisp_Process *));
302 static int read_process_output P_ ((Lisp_Object, int));
303
304 /* If we support a window system, turn on the code to poll periodically
305 to detect C-g. It isn't actually used when doing interrupt input. */
306 #ifdef HAVE_WINDOW_SYSTEM
307 #define POLL_FOR_INPUT
308 #endif
309
310 static Lisp_Object get_process ();
311 static void exec_sentinel ();
312
313 extern EMACS_TIME timer_check ();
314 extern int timers_run;
315 \f
316 /* Mask of bits indicating the descriptors that we wait for input on. */
317
318 static SELECT_TYPE input_wait_mask;
319
320 /* Mask that excludes keyboard input descriptor(s). */
321
322 static SELECT_TYPE non_keyboard_wait_mask;
323
324 /* Mask that excludes process input descriptor(s). */
325
326 static SELECT_TYPE non_process_wait_mask;
327
328 /* Mask for the gpm mouse input descriptor. */
329
330 static SELECT_TYPE gpm_wait_mask;
331
332 #ifdef NON_BLOCKING_CONNECT
333 /* Mask of bits indicating the descriptors that we wait for connect to
334 complete on. Once they complete, they are removed from this mask
335 and added to the input_wait_mask and non_keyboard_wait_mask. */
336
337 static SELECT_TYPE connect_wait_mask;
338
339 /* Number of bits set in connect_wait_mask. */
340 static int num_pending_connects;
341
342 #define IF_NON_BLOCKING_CONNECT(s) s
343 #else
344 #define IF_NON_BLOCKING_CONNECT(s)
345 #endif
346
347 /* The largest descriptor currently in use for a process object. */
348 static int max_process_desc;
349
350 /* The largest descriptor currently in use for keyboard input. */
351 static int max_keyboard_desc;
352
353 /* The largest descriptor currently in use for gpm mouse input. */
354 static int max_gpm_desc;
355
356 /* Nonzero means delete a process right away if it exits. */
357 static int delete_exited_processes;
358
359 /* Indexed by descriptor, gives the process (if any) for that descriptor */
360 Lisp_Object chan_process[MAXDESC];
361
362 /* Alist of elements (NAME . PROCESS) */
363 Lisp_Object Vprocess_alist;
364
365 /* Buffered-ahead input char from process, indexed by channel.
366 -1 means empty (no char is buffered).
367 Used on sys V where the only way to tell if there is any
368 output from the process is to read at least one char.
369 Always -1 on systems that support FIONREAD. */
370
371 /* Don't make static; need to access externally. */
372 int proc_buffered_char[MAXDESC];
373
374 /* Table of `struct coding-system' for each process. */
375 static struct coding_system *proc_decode_coding_system[MAXDESC];
376 static struct coding_system *proc_encode_coding_system[MAXDESC];
377
378 #ifdef DATAGRAM_SOCKETS
379 /* Table of `partner address' for datagram sockets. */
380 struct sockaddr_and_len {
381 struct sockaddr *sa;
382 int len;
383 } datagram_address[MAXDESC];
384 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
385 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
386 #else
387 #define DATAGRAM_CHAN_P(chan) (0)
388 #define DATAGRAM_CONN_P(proc) (0)
389 #endif
390
391 /* Maximum number of bytes to send to a pty without an eof. */
392 static int pty_max_bytes;
393
394 /* Nonzero means don't run process sentinels. This is used
395 when exiting. */
396 int inhibit_sentinels;
397
398 #ifdef HAVE_PTYS
399 #ifdef HAVE_PTY_H
400 #include <pty.h>
401 #endif
402 /* The file name of the pty opened by allocate_pty. */
403
404 static char pty_name[24];
405 #endif
406 \f
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
409
410 static Lisp_Object status_convert ();
411
412 static void
413 update_status (p)
414 struct Lisp_Process *p;
415 {
416 union { int i; WAITTYPE wt; } u;
417 eassert (p->raw_status_new);
418 u.i = p->raw_status;
419 p->status = status_convert (u.wt);
420 p->raw_status_new = 0;
421 }
422
423 /* Convert a process status word in Unix format to
424 the list that we use internally. */
425
426 static Lisp_Object
427 status_convert (w)
428 WAITTYPE w;
429 {
430 if (WIFSTOPPED (w))
431 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
432 else if (WIFEXITED (w))
433 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
434 WCOREDUMP (w) ? Qt : Qnil));
435 else if (WIFSIGNALED (w))
436 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
437 WCOREDUMP (w) ? Qt : Qnil));
438 else
439 return Qrun;
440 }
441
442 /* Given a status-list, extract the three pieces of information
443 and store them individually through the three pointers. */
444
445 static void
446 decode_status (l, symbol, code, coredump)
447 Lisp_Object l;
448 Lisp_Object *symbol;
449 int *code;
450 int *coredump;
451 {
452 Lisp_Object tem;
453
454 if (SYMBOLP (l))
455 {
456 *symbol = l;
457 *code = 0;
458 *coredump = 0;
459 }
460 else
461 {
462 *symbol = XCAR (l);
463 tem = XCDR (l);
464 *code = XFASTINT (XCAR (tem));
465 tem = XCDR (tem);
466 *coredump = !NILP (tem);
467 }
468 }
469
470 /* Return a string describing a process status list. */
471
472 static Lisp_Object
473 status_message (p)
474 struct Lisp_Process *p;
475 {
476 Lisp_Object status = p->status;
477 Lisp_Object symbol;
478 int code, coredump;
479 Lisp_Object string, string2;
480
481 decode_status (status, &symbol, &code, &coredump);
482
483 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
484 {
485 char *signame;
486 synchronize_system_messages_locale ();
487 signame = strsignal (code);
488 if (signame == 0)
489 signame = "unknown";
490 string = build_string (signame);
491 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
492 SSET (string, 0, DOWNCASE (SREF (string, 0)));
493 return concat2 (string, string2);
494 }
495 else if (EQ (symbol, Qexit))
496 {
497 if (NETCONN1_P (p))
498 return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
499 if (code == 0)
500 return build_string ("finished\n");
501 string = Fnumber_to_string (make_number (code));
502 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
503 return concat3 (build_string ("exited abnormally with code "),
504 string, string2);
505 }
506 else if (EQ (symbol, Qfailed))
507 {
508 string = Fnumber_to_string (make_number (code));
509 string2 = build_string ("\n");
510 return concat3 (build_string ("failed with code "),
511 string, string2);
512 }
513 else
514 return Fcopy_sequence (Fsymbol_name (symbol));
515 }
516 \f
517 #ifdef HAVE_PTYS
518
519 /* Open an available pty, returning a file descriptor.
520 Return -1 on failure.
521 The file name of the terminal corresponding to the pty
522 is left in the variable pty_name. */
523
524 static int
525 allocate_pty ()
526 {
527 register int c, i;
528 int fd;
529
530 #ifdef PTY_ITERATION
531 PTY_ITERATION
532 #else
533 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
534 for (i = 0; i < 16; i++)
535 #endif
536 {
537 struct stat stb; /* Used in some PTY_OPEN. */
538 #ifdef PTY_NAME_SPRINTF
539 PTY_NAME_SPRINTF
540 #else
541 sprintf (pty_name, "/dev/pty%c%x", c, i);
542 #endif /* no PTY_NAME_SPRINTF */
543
544 #ifdef PTY_OPEN
545 PTY_OPEN;
546 #else /* no PTY_OPEN */
547 {
548 # ifdef IRIS
549 /* Unusual IRIS code */
550 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
551 if (fd < 0)
552 return -1;
553 if (fstat (fd, &stb) < 0)
554 return -1;
555 # else /* not IRIS */
556 { /* Some systems name their pseudoterminals so that there are gaps in
557 the usual sequence - for example, on HP9000/S700 systems, there
558 are no pseudoterminals with names ending in 'f'. So we wait for
559 three failures in a row before deciding that we've reached the
560 end of the ptys. */
561 int failed_count = 0;
562
563 if (stat (pty_name, &stb) < 0)
564 {
565 failed_count++;
566 if (failed_count >= 3)
567 return -1;
568 }
569 else
570 failed_count = 0;
571 }
572 # ifdef O_NONBLOCK
573 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
574 # else
575 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
576 # endif
577 # endif /* not IRIS */
578 }
579 #endif /* no PTY_OPEN */
580
581 if (fd >= 0)
582 {
583 /* check to make certain that both sides are available
584 this avoids a nasty yet stupid bug in rlogins */
585 #ifdef PTY_TTY_NAME_SPRINTF
586 PTY_TTY_NAME_SPRINTF
587 #else
588 sprintf (pty_name, "/dev/tty%c%x", c, i);
589 #endif /* no PTY_TTY_NAME_SPRINTF */
590 if (access (pty_name, 6) != 0)
591 {
592 emacs_close (fd);
593 # if !defined(IRIS) && !defined(__sgi)
594 continue;
595 # else
596 return -1;
597 # endif /* IRIS */
598 }
599 setup_pty (fd);
600 return fd;
601 }
602 }
603 return -1;
604 }
605 #endif /* HAVE_PTYS */
606 \f
607 static Lisp_Object
608 make_process (name)
609 Lisp_Object name;
610 {
611 register Lisp_Object val, tem, name1;
612 register struct Lisp_Process *p;
613 char suffix[10];
614 register int i;
615
616 p = allocate_process ();
617
618 p->infd = -1;
619 p->outfd = -1;
620 p->tick = 0;
621 p->update_tick = 0;
622 p->pid = 0;
623 p->pty_flag = 0;
624 p->raw_status_new = 0;
625 p->status = Qrun;
626 p->mark = Fmake_marker ();
627
628 #ifdef ADAPTIVE_READ_BUFFERING
629 p->adaptive_read_buffering = 0;
630 p->read_output_delay = 0;
631 p->read_output_skip = 0;
632 #endif
633
634 /* If name is already in use, modify it until it is unused. */
635
636 name1 = name;
637 for (i = 1; ; i++)
638 {
639 tem = Fget_process (name1);
640 if (NILP (tem)) break;
641 sprintf (suffix, "<%d>", i);
642 name1 = concat2 (name, build_string (suffix));
643 }
644 name = name1;
645 p->name = name;
646 XSETPROCESS (val, p);
647 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
648 return val;
649 }
650
651 static void
652 remove_process (proc)
653 register Lisp_Object proc;
654 {
655 register Lisp_Object pair;
656
657 pair = Frassq (proc, Vprocess_alist);
658 Vprocess_alist = Fdelq (pair, Vprocess_alist);
659
660 deactivate_process (proc);
661 }
662
663 /* Setup coding systems of PROCESS. */
664
665 void
666 setup_process_coding_systems (process)
667 Lisp_Object process;
668 {
669 struct Lisp_Process *p = XPROCESS (process);
670 int inch = p->infd;
671 int outch = p->outfd;
672 Lisp_Object coding_system;
673
674 if (inch < 0 || outch < 0)
675 return;
676
677 if (!proc_decode_coding_system[inch])
678 proc_decode_coding_system[inch]
679 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
680 coding_system = p->decode_coding_system;
681 if (! NILP (p->filter))
682 ;
683 else if (BUFFERP (p->buffer))
684 {
685 if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
686 coding_system = raw_text_coding_system (coding_system);
687 }
688 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
689
690 if (!proc_encode_coding_system[outch])
691 proc_encode_coding_system[outch]
692 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
693 setup_coding_system (p->encode_coding_system,
694 proc_encode_coding_system[outch]);
695 }
696 \f
697 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
698 doc: /* Return t if OBJECT is a process. */)
699 (object)
700 Lisp_Object object;
701 {
702 return PROCESSP (object) ? Qt : Qnil;
703 }
704
705 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
706 doc: /* Return the process named NAME, or nil if there is none. */)
707 (name)
708 register Lisp_Object name;
709 {
710 if (PROCESSP (name))
711 return name;
712 CHECK_STRING (name);
713 return Fcdr (Fassoc (name, Vprocess_alist));
714 }
715
716 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
717 doc: /* Return the (or a) process associated with BUFFER.
718 BUFFER may be a buffer or the name of one. */)
719 (buffer)
720 register Lisp_Object buffer;
721 {
722 register Lisp_Object buf, tail, proc;
723
724 if (NILP (buffer)) return Qnil;
725 buf = Fget_buffer (buffer);
726 if (NILP (buf)) return Qnil;
727
728 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
729 {
730 proc = Fcdr (XCAR (tail));
731 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
732 return proc;
733 }
734 return Qnil;
735 }
736
737 /* This is how commands for the user decode process arguments. It
738 accepts a process, a process name, a buffer, a buffer name, or nil.
739 Buffers denote the first process in the buffer, and nil denotes the
740 current buffer. */
741
742 static Lisp_Object
743 get_process (name)
744 register Lisp_Object name;
745 {
746 register Lisp_Object proc, obj;
747 if (STRINGP (name))
748 {
749 obj = Fget_process (name);
750 if (NILP (obj))
751 obj = Fget_buffer (name);
752 if (NILP (obj))
753 error ("Process %s does not exist", SDATA (name));
754 }
755 else if (NILP (name))
756 obj = Fcurrent_buffer ();
757 else
758 obj = name;
759
760 /* Now obj should be either a buffer object or a process object.
761 */
762 if (BUFFERP (obj))
763 {
764 proc = Fget_buffer_process (obj);
765 if (NILP (proc))
766 error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
767 }
768 else
769 {
770 CHECK_PROCESS (obj);
771 proc = obj;
772 }
773 return proc;
774 }
775
776
777 #ifdef SIGCHLD
778 /* Fdelete_process promises to immediately forget about the process, but in
779 reality, Emacs needs to remember those processes until they have been
780 treated by sigchld_handler; otherwise this handler would consider the
781 process as being synchronous and say that the synchronous process is
782 dead. */
783 static Lisp_Object deleted_pid_list;
784 #endif
785
786 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
787 doc: /* Delete PROCESS: kill it and forget about it immediately.
788 PROCESS may be a process, a buffer, the name of a process or buffer, or
789 nil, indicating the current buffer's process. */)
790 (process)
791 register Lisp_Object process;
792 {
793 register struct Lisp_Process *p;
794
795 process = get_process (process);
796 p = XPROCESS (process);
797
798 p->raw_status_new = 0;
799 if (NETCONN1_P (p) || SERIALCONN1_P (p))
800 {
801 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
802 p->tick = ++process_tick;
803 status_notify (p);
804 }
805 else if (p->infd >= 0)
806 {
807 #ifdef SIGCHLD
808 Lisp_Object symbol;
809 /* Assignment to EMACS_INT stops GCC whining about limited range
810 of data type. */
811 EMACS_INT pid = p->pid;
812
813 /* No problem storing the pid here, as it is still in Vprocess_alist. */
814 deleted_pid_list = Fcons (make_fixnum_or_float (pid),
815 /* GC treated elements set to nil. */
816 Fdelq (Qnil, deleted_pid_list));
817 /* If the process has already signaled, remove it from the list. */
818 if (p->raw_status_new)
819 update_status (p);
820 symbol = p->status;
821 if (CONSP (p->status))
822 symbol = XCAR (p->status);
823 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
824 deleted_pid_list
825 = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
826 else
827 #endif
828 {
829 Fkill_process (process, Qnil);
830 /* Do this now, since remove_process will make sigchld_handler do nothing. */
831 p->status
832 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
833 p->tick = ++process_tick;
834 status_notify (p);
835 }
836 }
837 remove_process (process);
838 return Qnil;
839 }
840 \f
841 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
842 doc: /* Return the status of PROCESS.
843 The returned value is one of the following symbols:
844 run -- for a process that is running.
845 stop -- for a process stopped but continuable.
846 exit -- for a process that has exited.
847 signal -- for a process that has got a fatal signal.
848 open -- for a network stream connection that is open.
849 listen -- for a network stream server that is listening.
850 closed -- for a network stream connection that is closed.
851 connect -- when waiting for a non-blocking connection to complete.
852 failed -- when a non-blocking connection has failed.
853 nil -- if arg is a process name and no such process exists.
854 PROCESS may be a process, a buffer, the name of a process, or
855 nil, indicating the current buffer's process. */)
856 (process)
857 register Lisp_Object process;
858 {
859 register struct Lisp_Process *p;
860 register Lisp_Object status;
861
862 if (STRINGP (process))
863 process = Fget_process (process);
864 else
865 process = get_process (process);
866
867 if (NILP (process))
868 return process;
869
870 p = XPROCESS (process);
871 if (p->raw_status_new)
872 update_status (p);
873 status = p->status;
874 if (CONSP (status))
875 status = XCAR (status);
876 if (NETCONN1_P (p) || SERIALCONN1_P (p))
877 {
878 if (EQ (status, Qexit))
879 status = Qclosed;
880 else if (EQ (p->command, Qt))
881 status = Qstop;
882 else if (EQ (status, Qrun))
883 status = Qopen;
884 }
885 return status;
886 }
887
888 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
889 1, 1, 0,
890 doc: /* Return the exit status of PROCESS or the signal number that killed it.
891 If PROCESS has not yet exited or died, return 0. */)
892 (process)
893 register Lisp_Object process;
894 {
895 CHECK_PROCESS (process);
896 if (XPROCESS (process)->raw_status_new)
897 update_status (XPROCESS (process));
898 if (CONSP (XPROCESS (process)->status))
899 return XCAR (XCDR (XPROCESS (process)->status));
900 return make_number (0);
901 }
902
903 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
904 doc: /* Return the process id of PROCESS.
905 This is the pid of the external process which PROCESS uses or talks to.
906 For a network connection, this value is nil. */)
907 (process)
908 register Lisp_Object process;
909 {
910 /* Assignment to EMACS_INT stops GCC whining about limited range of
911 data type. */
912 EMACS_INT pid;
913
914 CHECK_PROCESS (process);
915 pid = XPROCESS (process)->pid;
916 return (pid ? make_fixnum_or_float (pid) : Qnil);
917 }
918
919 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
920 doc: /* Return the name of PROCESS, as a string.
921 This is the name of the program invoked in PROCESS,
922 possibly modified to make it unique among process names. */)
923 (process)
924 register Lisp_Object process;
925 {
926 CHECK_PROCESS (process);
927 return XPROCESS (process)->name;
928 }
929
930 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
931 doc: /* Return the command that was executed to start PROCESS.
932 This is a list of strings, the first string being the program executed
933 and the rest of the strings being the arguments given to it.
934 For a network or serial process, this is nil (process is running) or t
935 \(process is stopped). */)
936 (process)
937 register Lisp_Object process;
938 {
939 CHECK_PROCESS (process);
940 return XPROCESS (process)->command;
941 }
942
943 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
944 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
945 This is the terminal that the process itself reads and writes on,
946 not the name of the pty that Emacs uses to talk with that terminal. */)
947 (process)
948 register Lisp_Object process;
949 {
950 CHECK_PROCESS (process);
951 return XPROCESS (process)->tty_name;
952 }
953
954 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
955 2, 2, 0,
956 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
957 (process, buffer)
958 register Lisp_Object process, buffer;
959 {
960 struct Lisp_Process *p;
961
962 CHECK_PROCESS (process);
963 if (!NILP (buffer))
964 CHECK_BUFFER (buffer);
965 p = XPROCESS (process);
966 p->buffer = buffer;
967 if (NETCONN1_P (p) || SERIALCONN1_P (p))
968 p->childp = Fplist_put (p->childp, QCbuffer, buffer);
969 setup_process_coding_systems (process);
970 return buffer;
971 }
972
973 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
974 1, 1, 0,
975 doc: /* Return the buffer PROCESS is associated with.
976 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
977 (process)
978 register Lisp_Object process;
979 {
980 CHECK_PROCESS (process);
981 return XPROCESS (process)->buffer;
982 }
983
984 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
985 1, 1, 0,
986 doc: /* Return the marker for the end of the last output from PROCESS. */)
987 (process)
988 register Lisp_Object process;
989 {
990 CHECK_PROCESS (process);
991 return XPROCESS (process)->mark;
992 }
993
994 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
995 2, 2, 0,
996 doc: /* Give PROCESS the filter function FILTER; nil means no filter.
997 A value of t means stop accepting output from the process.
998
999 When a process has a filter, its buffer is not used for output.
1000 Instead, each time it does output, the entire string of output is
1001 passed to the filter.
1002
1003 The filter gets two arguments: the process and the string of output.
1004 The string argument is normally a multibyte string, except:
1005 - if the process' input coding system is no-conversion or raw-text,
1006 it is a unibyte string (the non-converted input), or else
1007 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1008 string (the result of converting the decoded input multibyte
1009 string to unibyte with `string-make-unibyte'). */)
1010 (process, filter)
1011 register Lisp_Object process, filter;
1012 {
1013 struct Lisp_Process *p;
1014
1015 CHECK_PROCESS (process);
1016 p = XPROCESS (process);
1017
1018 /* Don't signal an error if the process' input file descriptor
1019 is closed. This could make debugging Lisp more difficult,
1020 for example when doing something like
1021
1022 (setq process (start-process ...))
1023 (debug)
1024 (set-process-filter process ...) */
1025
1026 if (p->infd >= 0)
1027 {
1028 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
1029 {
1030 FD_CLR (p->infd, &input_wait_mask);
1031 FD_CLR (p->infd, &non_keyboard_wait_mask);
1032 }
1033 else if (EQ (p->filter, Qt)
1034 /* Network or serial process not stopped: */
1035 && !EQ (p->command, Qt))
1036 {
1037 FD_SET (p->infd, &input_wait_mask);
1038 FD_SET (p->infd, &non_keyboard_wait_mask);
1039 }
1040 }
1041
1042 p->filter = filter;
1043 if (NETCONN1_P (p) || SERIALCONN1_P (p))
1044 p->childp = Fplist_put (p->childp, QCfilter, filter);
1045 setup_process_coding_systems (process);
1046 return filter;
1047 }
1048
1049 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1050 1, 1, 0,
1051 doc: /* Returns the filter function of PROCESS; nil if none.
1052 See `set-process-filter' for more info on filter functions. */)
1053 (process)
1054 register Lisp_Object process;
1055 {
1056 CHECK_PROCESS (process);
1057 return XPROCESS (process)->filter;
1058 }
1059
1060 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1061 2, 2, 0,
1062 doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
1063 The sentinel is called as a function when the process changes state.
1064 It gets two arguments: the process, and a string describing the change. */)
1065 (process, sentinel)
1066 register Lisp_Object process, sentinel;
1067 {
1068 struct Lisp_Process *p;
1069
1070 CHECK_PROCESS (process);
1071 p = XPROCESS (process);
1072
1073 p->sentinel = sentinel;
1074 if (NETCONN1_P (p) || SERIALCONN1_P (p))
1075 p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
1076 return sentinel;
1077 }
1078
1079 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1080 1, 1, 0,
1081 doc: /* Return the sentinel of PROCESS; nil if none.
1082 See `set-process-sentinel' for more info on sentinels. */)
1083 (process)
1084 register Lisp_Object process;
1085 {
1086 CHECK_PROCESS (process);
1087 return XPROCESS (process)->sentinel;
1088 }
1089
1090 DEFUN ("set-process-window-size", Fset_process_window_size,
1091 Sset_process_window_size, 3, 3, 0,
1092 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1093 (process, height, width)
1094 register Lisp_Object process, height, width;
1095 {
1096 CHECK_PROCESS (process);
1097 CHECK_NATNUM (height);
1098 CHECK_NATNUM (width);
1099
1100 if (XPROCESS (process)->infd < 0
1101 || set_window_size (XPROCESS (process)->infd,
1102 XINT (height), XINT (width)) <= 0)
1103 return Qnil;
1104 else
1105 return Qt;
1106 }
1107
1108 DEFUN ("set-process-inherit-coding-system-flag",
1109 Fset_process_inherit_coding_system_flag,
1110 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1111 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1112 If the second argument FLAG is non-nil, then the variable
1113 `buffer-file-coding-system' of the buffer associated with PROCESS
1114 will be bound to the value of the coding system used to decode
1115 the process output.
1116
1117 This is useful when the coding system specified for the process buffer
1118 leaves either the character code conversion or the end-of-line conversion
1119 unspecified, or if the coding system used to decode the process output
1120 is more appropriate for saving the process buffer.
1121
1122 Binding the variable `inherit-process-coding-system' to non-nil before
1123 starting the process is an alternative way of setting the inherit flag
1124 for the process which will run. */)
1125 (process, flag)
1126 register Lisp_Object process, flag;
1127 {
1128 CHECK_PROCESS (process);
1129 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1130 return flag;
1131 }
1132
1133 DEFUN ("process-inherit-coding-system-flag",
1134 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
1135 1, 1, 0,
1136 doc: /* Return the value of inherit-coding-system flag for PROCESS.
1137 If this flag is t, `buffer-file-coding-system' of the buffer
1138 associated with PROCESS will inherit the coding system used to decode
1139 the process output. */)
1140 (process)
1141 register Lisp_Object process;
1142 {
1143 CHECK_PROCESS (process);
1144 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
1145 }
1146
1147 DEFUN ("set-process-query-on-exit-flag",
1148 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1149 2, 2, 0,
1150 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1151 If the second argument FLAG is non-nil, Emacs will query the user before
1152 exiting if PROCESS is running. */)
1153 (process, flag)
1154 register Lisp_Object process, flag;
1155 {
1156 CHECK_PROCESS (process);
1157 XPROCESS (process)->kill_without_query = NILP (flag);
1158 return flag;
1159 }
1160
1161 DEFUN ("process-query-on-exit-flag",
1162 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1163 1, 1, 0,
1164 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1165 (process)
1166 register Lisp_Object process;
1167 {
1168 CHECK_PROCESS (process);
1169 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1170 }
1171
1172 #ifdef DATAGRAM_SOCKETS
1173 Lisp_Object Fprocess_datagram_address ();
1174 #endif
1175
1176 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1177 1, 2, 0,
1178 doc: /* Return the contact info of PROCESS; t for a real child.
1179 For a network or serial connection, the value depends on the optional
1180 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1181 SERVICE) for a network connection or (PORT SPEED) for a serial
1182 connection. If KEY is t, the complete contact information for the
1183 connection is returned, else the specific value for the keyword KEY is
1184 returned. See `make-network-process' or `make-serial-process' for a
1185 list of keywords. */)
1186 (process, key)
1187 register Lisp_Object process, key;
1188 {
1189 Lisp_Object contact;
1190
1191 CHECK_PROCESS (process);
1192 contact = XPROCESS (process)->childp;
1193
1194 #ifdef DATAGRAM_SOCKETS
1195 if (DATAGRAM_CONN_P (process)
1196 && (EQ (key, Qt) || EQ (key, QCremote)))
1197 contact = Fplist_put (contact, QCremote,
1198 Fprocess_datagram_address (process));
1199 #endif
1200
1201 if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
1202 return contact;
1203 if (NILP (key) && NETCONN_P (process))
1204 return Fcons (Fplist_get (contact, QChost),
1205 Fcons (Fplist_get (contact, QCservice), Qnil));
1206 if (NILP (key) && SERIALCONN_P (process))
1207 return Fcons (Fplist_get (contact, QCport),
1208 Fcons (Fplist_get (contact, QCspeed), Qnil));
1209 return Fplist_get (contact, key);
1210 }
1211
1212 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1213 1, 1, 0,
1214 doc: /* Return the plist of PROCESS. */)
1215 (process)
1216 register Lisp_Object process;
1217 {
1218 CHECK_PROCESS (process);
1219 return XPROCESS (process)->plist;
1220 }
1221
1222 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1223 2, 2, 0,
1224 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1225 (process, plist)
1226 register Lisp_Object process, plist;
1227 {
1228 CHECK_PROCESS (process);
1229 CHECK_LIST (plist);
1230
1231 XPROCESS (process)->plist = plist;
1232 return plist;
1233 }
1234
1235 #if 0 /* Turned off because we don't currently record this info
1236 in the process. Perhaps add it. */
1237 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1238 doc: /* Return the connection type of PROCESS.
1239 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1240 a socket connection. */)
1241 (process)
1242 Lisp_Object process;
1243 {
1244 return XPROCESS (process)->type;
1245 }
1246 #endif
1247
1248 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1249 doc: /* Return the connection type of PROCESS.
1250 The value is either the symbol `real', `network', or `serial'.
1251 PROCESS may be a process, a buffer, the name of a process or buffer, or
1252 nil, indicating the current buffer's process. */)
1253 (process)
1254 Lisp_Object process;
1255 {
1256 Lisp_Object proc;
1257 proc = get_process (process);
1258 return XPROCESS (proc)->type;
1259 }
1260
1261 #ifdef HAVE_SOCKETS
1262 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1263 1, 2, 0,
1264 doc: /* Convert network ADDRESS from internal format to a string.
1265 A 4 or 5 element vector represents an IPv4 address (with port number).
1266 An 8 or 9 element vector represents an IPv6 address (with port number).
1267 If optional second argument OMIT-PORT is non-nil, don't include a port
1268 number in the string, even when present in ADDRESS.
1269 Returns nil if format of ADDRESS is invalid. */)
1270 (address, omit_port)
1271 Lisp_Object address, omit_port;
1272 {
1273 if (NILP (address))
1274 return Qnil;
1275
1276 if (STRINGP (address)) /* AF_LOCAL */
1277 return address;
1278
1279 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1280 {
1281 register struct Lisp_Vector *p = XVECTOR (address);
1282 Lisp_Object args[10];
1283 int nargs, i;
1284
1285 if (p->size == 4 || (p->size == 5 && !NILP (omit_port)))
1286 {
1287 args[0] = build_string ("%d.%d.%d.%d");
1288 nargs = 4;
1289 }
1290 else if (p->size == 5)
1291 {
1292 args[0] = build_string ("%d.%d.%d.%d:%d");
1293 nargs = 5;
1294 }
1295 else if (p->size == 8 || (p->size == 9 && !NILP (omit_port)))
1296 {
1297 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1298 nargs = 8;
1299 }
1300 else if (p->size == 9)
1301 {
1302 args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1303 nargs = 9;
1304 }
1305 else
1306 return Qnil;
1307
1308 for (i = 0; i < nargs; i++)
1309 {
1310 EMACS_INT element = XINT (p->contents[i]);
1311
1312 if (element < 0 || element > 65535)
1313 return Qnil;
1314
1315 if (nargs <= 5 /* IPv4 */
1316 && i < 4 /* host, not port */
1317 && element > 255)
1318 return Qnil;
1319
1320 args[i+1] = p->contents[i];
1321 }
1322
1323 return Fformat (nargs+1, args);
1324 }
1325
1326 if (CONSP (address))
1327 {
1328 Lisp_Object args[2];
1329 args[0] = build_string ("<Family %d>");
1330 args[1] = Fcar (address);
1331 return Fformat (2, args);
1332 }
1333
1334 return Qnil;
1335 }
1336 #endif
1337 \f
1338 static Lisp_Object
1339 list_processes_1 (query_only)
1340 Lisp_Object query_only;
1341 {
1342 register Lisp_Object tail, tem;
1343 Lisp_Object proc, minspace, tem1;
1344 register struct Lisp_Process *p;
1345 char tembuf[300];
1346 int w_proc, w_buffer, w_tty;
1347 int exited = 0;
1348 Lisp_Object i_status, i_buffer, i_tty, i_command;
1349
1350 w_proc = 4; /* Proc */
1351 w_buffer = 6; /* Buffer */
1352 w_tty = 0; /* Omit if no ttys */
1353
1354 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
1355 {
1356 int i;
1357
1358 proc = Fcdr (XCAR (tail));
1359 p = XPROCESS (proc);
1360 if (NILP (p->type))
1361 continue;
1362 if (!NILP (query_only) && p->kill_without_query)
1363 continue;
1364 if (STRINGP (p->name)
1365 && ( i = SCHARS (p->name), (i > w_proc)))
1366 w_proc = i;
1367 if (!NILP (p->buffer))
1368 {
1369 if (NILP (XBUFFER (p->buffer)->name))
1370 {
1371 if (w_buffer < 8)
1372 w_buffer = 8; /* (Killed) */
1373 }
1374 else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
1375 w_buffer = i;
1376 }
1377 if (STRINGP (p->tty_name)
1378 && (i = SCHARS (p->tty_name), (i > w_tty)))
1379 w_tty = i;
1380 }
1381
1382 XSETFASTINT (i_status, w_proc + 1);
1383 XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
1384 if (w_tty)
1385 {
1386 XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
1387 XSETFASTINT (i_command, XFASTINT (i_tty) + w_tty + 1);
1388 }
1389 else
1390 {
1391 i_tty = Qnil;
1392 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
1393 }
1394
1395 XSETFASTINT (minspace, 1);
1396
1397 set_buffer_internal (XBUFFER (Vstandard_output));
1398 current_buffer->undo_list = Qt;
1399
1400 current_buffer->truncate_lines = Qt;
1401
1402 write_string ("Proc", -1);
1403 Findent_to (i_status, minspace); write_string ("Status", -1);
1404 Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
1405 if (!NILP (i_tty))
1406 {
1407 Findent_to (i_tty, minspace); write_string ("Tty", -1);
1408 }
1409 Findent_to (i_command, minspace); write_string ("Command", -1);
1410 write_string ("\n", -1);
1411
1412 write_string ("----", -1);
1413 Findent_to (i_status, minspace); write_string ("------", -1);
1414 Findent_to (i_buffer, minspace); write_string ("------", -1);
1415 if (!NILP (i_tty))
1416 {
1417 Findent_to (i_tty, minspace); write_string ("---", -1);
1418 }
1419 Findent_to (i_command, minspace); write_string ("-------", -1);
1420 write_string ("\n", -1);
1421
1422 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
1423 {
1424 Lisp_Object symbol;
1425
1426 proc = Fcdr (XCAR (tail));
1427 p = XPROCESS (proc);
1428 if (NILP (p->type))
1429 continue;
1430 if (!NILP (query_only) && p->kill_without_query)
1431 continue;
1432
1433 Finsert (1, &p->name);
1434 Findent_to (i_status, minspace);
1435
1436 if (p->raw_status_new)
1437 update_status (p);
1438 symbol = p->status;
1439 if (CONSP (p->status))
1440 symbol = XCAR (p->status);
1441
1442 if (EQ (symbol, Qsignal))
1443 {
1444 Lisp_Object tem;
1445 tem = Fcar (Fcdr (p->status));
1446 #ifdef VMS
1447 if (XINT (tem) < NSIG)
1448 write_string (sys_errlist [XINT (tem)], -1);
1449 else
1450 #endif
1451 Fprinc (symbol, Qnil);
1452 }
1453 else if (NETCONN1_P (p) || SERIALCONN1_P (p))
1454 {
1455 if (EQ (symbol, Qexit))
1456 write_string ("closed", -1);
1457 else if (EQ (p->command, Qt))
1458 write_string ("stopped", -1);
1459 else if (EQ (symbol, Qrun))
1460 write_string ("open", -1);
1461 else
1462 Fprinc (symbol, Qnil);
1463 }
1464 else if (SERIALCONN1_P (p))
1465 {
1466 write_string ("running", -1);
1467 }
1468 else
1469 Fprinc (symbol, Qnil);
1470
1471 if (EQ (symbol, Qexit))
1472 {
1473 Lisp_Object tem;
1474 tem = Fcar (Fcdr (p->status));
1475 if (XFASTINT (tem))
1476 {
1477 sprintf (tembuf, " %d", (int) XFASTINT (tem));
1478 write_string (tembuf, -1);
1479 }
1480 }
1481
1482 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed))
1483 exited++;
1484
1485 Findent_to (i_buffer, minspace);
1486 if (NILP (p->buffer))
1487 insert_string ("(none)");
1488 else if (NILP (XBUFFER (p->buffer)->name))
1489 insert_string ("(Killed)");
1490 else
1491 Finsert (1, &XBUFFER (p->buffer)->name);
1492
1493 if (!NILP (i_tty))
1494 {
1495 Findent_to (i_tty, minspace);
1496 if (STRINGP (p->tty_name))
1497 Finsert (1, &p->tty_name);
1498 }
1499
1500 Findent_to (i_command, minspace);
1501
1502 if (EQ (p->status, Qlisten))
1503 {
1504 Lisp_Object port = Fplist_get (p->childp, QCservice);
1505 if (INTEGERP (port))
1506 port = Fnumber_to_string (port);
1507 if (NILP (port))
1508 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
1509 sprintf (tembuf, "(network %s server on %s)\n",
1510 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1511 (STRINGP (port) ? (char *)SDATA (port) : "?"));
1512 insert_string (tembuf);
1513 }
1514 else if (NETCONN1_P (p))
1515 {
1516 /* For a local socket, there is no host name,
1517 so display service instead. */
1518 Lisp_Object host = Fplist_get (p->childp, QChost);
1519 if (!STRINGP (host))
1520 {
1521 host = Fplist_get (p->childp, QCservice);
1522 if (INTEGERP (host))
1523 host = Fnumber_to_string (host);
1524 }
1525 if (NILP (host))
1526 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
1527 sprintf (tembuf, "(network %s connection to %s)\n",
1528 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1529 (STRINGP (host) ? (char *)SDATA (host) : "?"));
1530 insert_string (tembuf);
1531 }
1532 else if (SERIALCONN1_P (p))
1533 {
1534 Lisp_Object port = Fplist_get (p->childp, QCport);
1535 Lisp_Object speed = Fplist_get (p->childp, QCspeed);
1536 insert_string ("(serial port ");
1537 if (STRINGP (port))
1538 insert_string (SDATA (port));
1539 else
1540 insert_string ("?");
1541 if (INTEGERP (speed))
1542 {
1543 sprintf (tembuf, " at %d b/s", XINT (speed));
1544 insert_string (tembuf);
1545 }
1546 insert_string (")\n");
1547 }
1548 else
1549 {
1550 tem = p->command;
1551 while (1)
1552 {
1553 tem1 = Fcar (tem);
1554 Finsert (1, &tem1);
1555 tem = Fcdr (tem);
1556 if (NILP (tem))
1557 break;
1558 insert_string (" ");
1559 }
1560 insert_string ("\n");
1561 }
1562 }
1563 if (exited)
1564 status_notify (NULL);
1565 return Qnil;
1566 }
1567
1568 DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
1569 doc: /* Display a list of all processes.
1570 If optional argument QUERY-ONLY is non-nil, only processes with
1571 the query-on-exit flag set will be listed.
1572 Any process listed as exited or signaled is actually eliminated
1573 after the listing is made. */)
1574 (query_only)
1575 Lisp_Object query_only;
1576 {
1577 internal_with_output_to_temp_buffer ("*Process List*",
1578 list_processes_1, query_only);
1579 return Qnil;
1580 }
1581
1582 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1583 doc: /* Return a list of all processes. */)
1584 ()
1585 {
1586 return Fmapcar (Qcdr, Vprocess_alist);
1587 }
1588 \f
1589 /* Starting asynchronous inferior processes. */
1590
1591 static Lisp_Object start_process_unwind ();
1592
1593 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1594 doc: /* Start a program in a subprocess. Return the process object for it.
1595 NAME is name for process. It is modified if necessary to make it unique.
1596 BUFFER is the buffer (or buffer name) to associate with the process.
1597
1598 Process output (both standard output and standard error streams) goes
1599 at end of BUFFER, unless you specify an output stream or filter
1600 function to handle the output. BUFFER may also be nil, meaning that
1601 this process is not associated with any buffer.
1602
1603 PROGRAM is the program file name. It is searched for in PATH.
1604 Remaining arguments are strings to give program as arguments.
1605
1606 If you want to separate standard output from standard error, invoke
1607 the command through a shell and redirect one of them using the shell
1608 syntax.
1609
1610 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1611 (nargs, args)
1612 int nargs;
1613 register Lisp_Object *args;
1614 {
1615 Lisp_Object buffer, name, program, proc, current_dir, tem;
1616 #ifdef VMS
1617 register unsigned char *new_argv;
1618 int len;
1619 #else
1620 register unsigned char **new_argv;
1621 #endif
1622 register int i;
1623 int count = SPECPDL_INDEX ();
1624
1625 buffer = args[1];
1626 if (!NILP (buffer))
1627 buffer = Fget_buffer_create (buffer);
1628
1629 /* Make sure that the child will be able to chdir to the current
1630 buffer's current directory, or its unhandled equivalent. We
1631 can't just have the child check for an error when it does the
1632 chdir, since it's in a vfork.
1633
1634 We have to GCPRO around this because Fexpand_file_name and
1635 Funhandled_file_name_directory might call a file name handling
1636 function. The argument list is protected by the caller, so all
1637 we really have to worry about is buffer. */
1638 {
1639 struct gcpro gcpro1, gcpro2;
1640
1641 current_dir = current_buffer->directory;
1642
1643 GCPRO2 (buffer, current_dir);
1644
1645 current_dir = Funhandled_file_name_directory (current_dir);
1646 if (NILP (current_dir))
1647 /* If the file name handler says that current_dir is unreachable, use
1648 a sensible default. */
1649 current_dir = build_string ("~/");
1650 current_dir = expand_and_dir_to_file (current_dir, Qnil);
1651 if (NILP (Ffile_accessible_directory_p (current_dir)))
1652 report_file_error ("Setting current directory",
1653 Fcons (current_buffer->directory, Qnil));
1654
1655 UNGCPRO;
1656 }
1657
1658 name = args[0];
1659 CHECK_STRING (name);
1660
1661 program = args[2];
1662
1663 CHECK_STRING (program);
1664
1665 proc = make_process (name);
1666 /* If an error occurs and we can't start the process, we want to
1667 remove it from the process list. This means that each error
1668 check in create_process doesn't need to call remove_process
1669 itself; it's all taken care of here. */
1670 record_unwind_protect (start_process_unwind, proc);
1671
1672 XPROCESS (proc)->childp = Qt;
1673 XPROCESS (proc)->plist = Qnil;
1674 XPROCESS (proc)->type = Qreal;
1675 XPROCESS (proc)->buffer = buffer;
1676 XPROCESS (proc)->sentinel = Qnil;
1677 XPROCESS (proc)->filter = Qnil;
1678 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1679
1680 #ifdef ADAPTIVE_READ_BUFFERING
1681 XPROCESS (proc)->adaptive_read_buffering
1682 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1683 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1684 #endif
1685
1686 /* Make the process marker point into the process buffer (if any). */
1687 if (BUFFERP (buffer))
1688 set_marker_both (XPROCESS (proc)->mark, buffer,
1689 BUF_ZV (XBUFFER (buffer)),
1690 BUF_ZV_BYTE (XBUFFER (buffer)));
1691
1692 {
1693 /* Decide coding systems for communicating with the process. Here
1694 we don't setup the structure coding_system nor pay attention to
1695 unibyte mode. They are done in create_process. */
1696
1697 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1698 Lisp_Object coding_systems = Qt;
1699 Lisp_Object val, *args2;
1700 struct gcpro gcpro1, gcpro2;
1701
1702 val = Vcoding_system_for_read;
1703 if (NILP (val))
1704 {
1705 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1706 args2[0] = Qstart_process;
1707 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1708 GCPRO2 (proc, current_dir);
1709 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1710 UNGCPRO;
1711 if (CONSP (coding_systems))
1712 val = XCAR (coding_systems);
1713 else if (CONSP (Vdefault_process_coding_system))
1714 val = XCAR (Vdefault_process_coding_system);
1715 }
1716 XPROCESS (proc)->decode_coding_system = val;
1717
1718 val = Vcoding_system_for_write;
1719 if (NILP (val))
1720 {
1721 if (EQ (coding_systems, Qt))
1722 {
1723 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
1724 args2[0] = Qstart_process;
1725 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1726 GCPRO2 (proc, current_dir);
1727 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1728 UNGCPRO;
1729 }
1730 if (CONSP (coding_systems))
1731 val = XCDR (coding_systems);
1732 else if (CONSP (Vdefault_process_coding_system))
1733 val = XCDR (Vdefault_process_coding_system);
1734 }
1735 XPROCESS (proc)->encode_coding_system = val;
1736 }
1737
1738 #ifdef VMS
1739 /* Make a one member argv with all args concatenated
1740 together separated by a blank. */
1741 len = SBYTES (program) + 2;
1742 for (i = 3; i < nargs; i++)
1743 {
1744 tem = args[i];
1745 CHECK_STRING (tem);
1746 len += SBYTES (tem) + 1; /* count the blank */
1747 }
1748 new_argv = (unsigned char *) alloca (len);
1749 strcpy (new_argv, SDATA (program));
1750 for (i = 3; i < nargs; i++)
1751 {
1752 tem = args[i];
1753 CHECK_STRING (tem);
1754 strcat (new_argv, " ");
1755 strcat (new_argv, SDATA (tem));
1756 }
1757 /* Need to add code here to check for program existence on VMS */
1758
1759 #else /* not VMS */
1760 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1761
1762 /* If program file name is not absolute, search our path for it.
1763 Put the name we will really use in TEM. */
1764 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1765 && !(SCHARS (program) > 1
1766 && IS_DEVICE_SEP (SREF (program, 1))))
1767 {
1768 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1769
1770 tem = Qnil;
1771 GCPRO4 (name, program, buffer, current_dir);
1772 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
1773 UNGCPRO;
1774 if (NILP (tem))
1775 report_file_error ("Searching for program", Fcons (program, Qnil));
1776 tem = Fexpand_file_name (tem, Qnil);
1777 }
1778 else
1779 {
1780 if (!NILP (Ffile_directory_p (program)))
1781 error ("Specified program for new process is a directory");
1782 tem = program;
1783 }
1784
1785 /* If program file name starts with /: for quoting a magic name,
1786 discard that. */
1787 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
1788 && SREF (tem, 1) == ':')
1789 tem = Fsubstring (tem, make_number (2), Qnil);
1790
1791 /* Encode the file name and put it in NEW_ARGV.
1792 That's where the child will use it to execute the program. */
1793 tem = ENCODE_FILE (tem);
1794 new_argv[0] = SDATA (tem);
1795
1796 /* Here we encode arguments by the coding system used for sending
1797 data to the process. We don't support using different coding
1798 systems for encoding arguments and for encoding data sent to the
1799 process. */
1800
1801 for (i = 3; i < nargs; i++)
1802 {
1803 tem = args[i];
1804 CHECK_STRING (tem);
1805 if (STRING_MULTIBYTE (tem))
1806 tem = (code_convert_string_norecord
1807 (tem, XPROCESS (proc)->encode_coding_system, 1));
1808 new_argv[i - 2] = SDATA (tem);
1809 }
1810 new_argv[i - 2] = 0;
1811 #endif /* not VMS */
1812
1813 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
1814 XPROCESS (proc)->decoding_carryover = 0;
1815 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
1816
1817 XPROCESS (proc)->inherit_coding_system_flag
1818 = !(NILP (buffer) || !inherit_process_coding_system);
1819
1820 create_process (proc, (char **) new_argv, current_dir);
1821
1822 return unbind_to (count, proc);
1823 }
1824
1825 /* This function is the unwind_protect form for Fstart_process. If
1826 PROC doesn't have its pid set, then we know someone has signaled
1827 an error and the process wasn't started successfully, so we should
1828 remove it from the process list. */
1829 static Lisp_Object
1830 start_process_unwind (proc)
1831 Lisp_Object proc;
1832 {
1833 if (!PROCESSP (proc))
1834 abort ();
1835
1836 /* Was PROC started successfully? */
1837 if (XPROCESS (proc)->pid <= 0)
1838 remove_process (proc);
1839
1840 return Qnil;
1841 }
1842
1843 static void
1844 create_process_1 (timer)
1845 struct atimer *timer;
1846 {
1847 /* Nothing to do. */
1848 }
1849
1850
1851 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1852 #ifdef USG
1853 #ifdef SIGCHLD
1854 /* Mimic blocking of signals on system V, which doesn't really have it. */
1855
1856 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1857 int sigchld_deferred;
1858
1859 SIGTYPE
1860 create_process_sigchld ()
1861 {
1862 signal (SIGCHLD, create_process_sigchld);
1863
1864 sigchld_deferred = 1;
1865 }
1866 #endif
1867 #endif
1868 #endif
1869
1870 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1871 void
1872 create_process (process, new_argv, current_dir)
1873 Lisp_Object process;
1874 char **new_argv;
1875 Lisp_Object current_dir;
1876 {
1877 int inchannel, outchannel;
1878 pid_t pid;
1879 int sv[2];
1880 #ifdef POSIX_SIGNALS
1881 sigset_t procmask;
1882 sigset_t blocked;
1883 struct sigaction sigint_action;
1884 struct sigaction sigquit_action;
1885 #ifdef AIX
1886 struct sigaction sighup_action;
1887 #endif
1888 #else /* !POSIX_SIGNALS */
1889 #if 0
1890 #ifdef SIGCHLD
1891 SIGTYPE (*sigchld)();
1892 #endif
1893 #endif /* 0 */
1894 #endif /* !POSIX_SIGNALS */
1895 /* Use volatile to protect variables from being clobbered by longjmp. */
1896 volatile int forkin, forkout;
1897 volatile int pty_flag = 0;
1898 #ifndef USE_CRT_DLL
1899 extern char **environ;
1900 #endif
1901
1902 inchannel = outchannel = -1;
1903
1904 #ifdef HAVE_PTYS
1905 if (!NILP (Vprocess_connection_type))
1906 outchannel = inchannel = allocate_pty ();
1907
1908 if (inchannel >= 0)
1909 {
1910 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1911 /* On most USG systems it does not work to open the pty's tty here,
1912 then close it and reopen it in the child. */
1913 #ifdef O_NOCTTY
1914 /* Don't let this terminal become our controlling terminal
1915 (in case we don't have one). */
1916 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1917 #else
1918 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
1919 #endif
1920 if (forkin < 0)
1921 report_file_error ("Opening pty", Qnil);
1922 #if defined (DONT_REOPEN_PTY)
1923 /* In the case that vfork is defined as fork, the parent process
1924 (Emacs) may send some data before the child process completes
1925 tty options setup. So we setup tty before forking. */
1926 child_setup_tty (forkout);
1927 #endif /* DONT_REOPEN_PTY */
1928 #else
1929 forkin = forkout = -1;
1930 #endif /* not USG, or USG_SUBTTY_WORKS */
1931 pty_flag = 1;
1932 }
1933 else
1934 #endif /* HAVE_PTYS */
1935 {
1936 int tem;
1937 tem = pipe (sv);
1938 if (tem < 0)
1939 report_file_error ("Creating pipe", Qnil);
1940 inchannel = sv[0];
1941 forkout = sv[1];
1942 tem = pipe (sv);
1943 if (tem < 0)
1944 {
1945 emacs_close (inchannel);
1946 emacs_close (forkout);
1947 report_file_error ("Creating pipe", Qnil);
1948 }
1949 outchannel = sv[1];
1950 forkin = sv[0];
1951 }
1952
1953 #if 0
1954 /* Replaced by close_process_descs */
1955 set_exclusive_use (inchannel);
1956 set_exclusive_use (outchannel);
1957 #endif
1958
1959 #ifdef O_NONBLOCK
1960 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1961 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1962 #else
1963 #ifdef O_NDELAY
1964 fcntl (inchannel, F_SETFL, O_NDELAY);
1965 fcntl (outchannel, F_SETFL, O_NDELAY);
1966 #endif
1967 #endif
1968
1969 /* Record this as an active process, with its channels.
1970 As a result, child_setup will close Emacs's side of the pipes. */
1971 chan_process[inchannel] = process;
1972 XPROCESS (process)->infd = inchannel;
1973 XPROCESS (process)->outfd = outchannel;
1974
1975 /* Previously we recorded the tty descriptor used in the subprocess.
1976 It was only used for getting the foreground tty process, so now
1977 we just reopen the device (see emacs_get_tty_pgrp) as this is
1978 more portable (see USG_SUBTTY_WORKS above). */
1979
1980 XPROCESS (process)->pty_flag = pty_flag;
1981 XPROCESS (process)->status = Qrun;
1982 setup_process_coding_systems (process);
1983
1984 /* Delay interrupts until we have a chance to store
1985 the new fork's pid in its process structure */
1986 #ifdef POSIX_SIGNALS
1987 sigemptyset (&blocked);
1988 #ifdef SIGCHLD
1989 sigaddset (&blocked, SIGCHLD);
1990 #endif
1991 #ifdef HAVE_WORKING_VFORK
1992 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1993 this sets the parent's signal handlers as well as the child's.
1994 So delay all interrupts whose handlers the child might munge,
1995 and record the current handlers so they can be restored later. */
1996 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1997 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
1998 #ifdef AIX
1999 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
2000 #endif
2001 #endif /* HAVE_WORKING_VFORK */
2002 sigprocmask (SIG_BLOCK, &blocked, &procmask);
2003 #else /* !POSIX_SIGNALS */
2004 #ifdef SIGCHLD
2005 #if defined (BSD_SYSTEM) || defined (HPUX)
2006 sigsetmask (sigmask (SIGCHLD));
2007 #else /* ordinary USG */
2008 #if 0
2009 sigchld_deferred = 0;
2010 sigchld = signal (SIGCHLD, create_process_sigchld);
2011 #endif
2012 #endif /* ordinary USG */
2013 #endif /* SIGCHLD */
2014 #endif /* !POSIX_SIGNALS */
2015
2016 FD_SET (inchannel, &input_wait_mask);
2017 FD_SET (inchannel, &non_keyboard_wait_mask);
2018 if (inchannel > max_process_desc)
2019 max_process_desc = inchannel;
2020
2021 /* Until we store the proper pid, enable sigchld_handler
2022 to recognize an unknown pid as standing for this process.
2023 It is very important not to let this `marker' value stay
2024 in the table after this function has returned; if it does
2025 it might cause call-process to hang and subsequent asynchronous
2026 processes to get their return values scrambled. */
2027 XPROCESS (process)->pid = -1;
2028
2029 BLOCK_INPUT;
2030
2031 {
2032 /* child_setup must clobber environ on systems with true vfork.
2033 Protect it from permanent change. */
2034 char **save_environ = environ;
2035
2036 current_dir = ENCODE_FILE (current_dir);
2037
2038 #ifndef WINDOWSNT
2039 pid = vfork ();
2040 if (pid == 0)
2041 #endif /* not WINDOWSNT */
2042 {
2043 int xforkin = forkin;
2044 int xforkout = forkout;
2045
2046 #if 0 /* This was probably a mistake--it duplicates code later on,
2047 but fails to handle all the cases. */
2048 /* Make sure SIGCHLD is not blocked in the child. */
2049 sigsetmask (SIGEMPTYMASK);
2050 #endif
2051
2052 /* Make the pty be the controlling terminal of the process. */
2053 #ifdef HAVE_PTYS
2054 /* First, disconnect its current controlling terminal. */
2055 #ifdef HAVE_SETSID
2056 /* We tried doing setsid only if pty_flag, but it caused
2057 process_set_signal to fail on SGI when using a pipe. */
2058 setsid ();
2059 /* Make the pty's terminal the controlling terminal. */
2060 if (pty_flag)
2061 {
2062 #ifdef TIOCSCTTY
2063 /* We ignore the return value
2064 because faith@cs.unc.edu says that is necessary on Linux. */
2065 ioctl (xforkin, TIOCSCTTY, 0);
2066 #endif
2067 }
2068 #else /* not HAVE_SETSID */
2069 #ifdef USG
2070 /* It's very important to call setpgrp here and no time
2071 afterwards. Otherwise, we lose our controlling tty which
2072 is set when we open the pty. */
2073 setpgrp ();
2074 #endif /* USG */
2075 #endif /* not HAVE_SETSID */
2076 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2077 if (pty_flag && xforkin >= 0)
2078 {
2079 struct termios t;
2080 tcgetattr (xforkin, &t);
2081 t.c_lflag = LDISC1;
2082 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
2083 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2084 }
2085 #else
2086 #if defined (NTTYDISC) && defined (TIOCSETD)
2087 if (pty_flag && xforkin >= 0)
2088 {
2089 /* Use new line discipline. */
2090 int ldisc = NTTYDISC;
2091 ioctl (xforkin, TIOCSETD, &ldisc);
2092 }
2093 #endif
2094 #endif
2095 #ifdef TIOCNOTTY
2096 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2097 can do TIOCSPGRP only to the process's controlling tty. */
2098 if (pty_flag)
2099 {
2100 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2101 I can't test it since I don't have 4.3. */
2102 int j = emacs_open ("/dev/tty", O_RDWR, 0);
2103 ioctl (j, TIOCNOTTY, 0);
2104 emacs_close (j);
2105 #ifndef USG
2106 /* In order to get a controlling terminal on some versions
2107 of BSD, it is necessary to put the process in pgrp 0
2108 before it opens the terminal. */
2109 #ifdef HAVE_SETPGID
2110 setpgid (0, 0);
2111 #else
2112 setpgrp (0, 0);
2113 #endif
2114 #endif
2115 }
2116 #endif /* TIOCNOTTY */
2117
2118 #if !defined (DONT_REOPEN_PTY)
2119 /*** There is a suggestion that this ought to be a
2120 conditional on TIOCSPGRP,
2121 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2122 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2123 that system does seem to need this code, even though
2124 both HAVE_SETSID and TIOCSCTTY are defined. */
2125 /* Now close the pty (if we had it open) and reopen it.
2126 This makes the pty the controlling terminal of the subprocess. */
2127 if (pty_flag)
2128 {
2129
2130 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2131 would work? */
2132 if (xforkin >= 0)
2133 emacs_close (xforkin);
2134 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
2135
2136 if (xforkin < 0)
2137 {
2138 emacs_write (1, "Couldn't open the pty terminal ", 31);
2139 emacs_write (1, pty_name, strlen (pty_name));
2140 emacs_write (1, "\n", 1);
2141 _exit (1);
2142 }
2143
2144 }
2145 #endif /* not DONT_REOPEN_PTY */
2146
2147 #ifdef SETUP_SLAVE_PTY
2148 if (pty_flag)
2149 {
2150 SETUP_SLAVE_PTY;
2151 }
2152 #endif /* SETUP_SLAVE_PTY */
2153 #ifdef AIX
2154 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2155 Now reenable it in the child, so it will die when we want it to. */
2156 if (pty_flag)
2157 signal (SIGHUP, SIG_DFL);
2158 #endif
2159 #endif /* HAVE_PTYS */
2160
2161 signal (SIGINT, SIG_DFL);
2162 signal (SIGQUIT, SIG_DFL);
2163
2164 /* Stop blocking signals in the child. */
2165 #ifdef POSIX_SIGNALS
2166 sigprocmask (SIG_SETMASK, &procmask, 0);
2167 #else /* !POSIX_SIGNALS */
2168 #ifdef SIGCHLD
2169 #if defined (BSD_SYSTEM) || defined (HPUX)
2170 sigsetmask (SIGEMPTYMASK);
2171 #else /* ordinary USG */
2172 #if 0
2173 signal (SIGCHLD, sigchld);
2174 #endif
2175 #endif /* ordinary USG */
2176 #endif /* SIGCHLD */
2177 #endif /* !POSIX_SIGNALS */
2178
2179 #if !defined (DONT_REOPEN_PTY)
2180 if (pty_flag)
2181 child_setup_tty (xforkout);
2182 #endif /* not DONT_REOPEN_PTY */
2183 #ifdef WINDOWSNT
2184 pid = child_setup (xforkin, xforkout, xforkout,
2185 new_argv, 1, current_dir);
2186 #else /* not WINDOWSNT */
2187 child_setup (xforkin, xforkout, xforkout,
2188 new_argv, 1, current_dir);
2189 #endif /* not WINDOWSNT */
2190 }
2191 environ = save_environ;
2192 }
2193
2194 UNBLOCK_INPUT;
2195
2196 /* This runs in the Emacs process. */
2197 if (pid < 0)
2198 {
2199 if (forkin >= 0)
2200 emacs_close (forkin);
2201 if (forkin != forkout && forkout >= 0)
2202 emacs_close (forkout);
2203 }
2204 else
2205 {
2206 /* vfork succeeded. */
2207 XPROCESS (process)->pid = pid;
2208
2209 #ifdef WINDOWSNT
2210 register_child (pid, inchannel);
2211 #endif /* WINDOWSNT */
2212
2213 /* If the subfork execv fails, and it exits,
2214 this close hangs. I don't know why.
2215 So have an interrupt jar it loose. */
2216 {
2217 struct atimer *timer;
2218 EMACS_TIME offset;
2219
2220 stop_polling ();
2221 EMACS_SET_SECS_USECS (offset, 1, 0);
2222 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
2223
2224 if (forkin >= 0)
2225 emacs_close (forkin);
2226
2227 cancel_atimer (timer);
2228 start_polling ();
2229 }
2230
2231 if (forkin != forkout && forkout >= 0)
2232 emacs_close (forkout);
2233
2234 #ifdef HAVE_PTYS
2235 if (pty_flag)
2236 XPROCESS (process)->tty_name = build_string (pty_name);
2237 else
2238 #endif
2239 XPROCESS (process)->tty_name = Qnil;
2240 }
2241
2242 /* Restore the signal state whether vfork succeeded or not.
2243 (We will signal an error, below, if it failed.) */
2244 #ifdef POSIX_SIGNALS
2245 #ifdef HAVE_WORKING_VFORK
2246 /* Restore the parent's signal handlers. */
2247 sigaction (SIGINT, &sigint_action, 0);
2248 sigaction (SIGQUIT, &sigquit_action, 0);
2249 #ifdef AIX
2250 sigaction (SIGHUP, &sighup_action, 0);
2251 #endif
2252 #endif /* HAVE_WORKING_VFORK */
2253 /* Stop blocking signals in the parent. */
2254 sigprocmask (SIG_SETMASK, &procmask, 0);
2255 #else /* !POSIX_SIGNALS */
2256 #ifdef SIGCHLD
2257 #if defined (BSD_SYSTEM) || defined (HPUX)
2258 sigsetmask (SIGEMPTYMASK);
2259 #else /* ordinary USG */
2260 #if 0
2261 signal (SIGCHLD, sigchld);
2262 /* Now really handle any of these signals
2263 that came in during this function. */
2264 if (sigchld_deferred)
2265 kill (getpid (), SIGCHLD);
2266 #endif
2267 #endif /* ordinary USG */
2268 #endif /* SIGCHLD */
2269 #endif /* !POSIX_SIGNALS */
2270
2271 /* Now generate the error if vfork failed. */
2272 if (pid < 0)
2273 report_file_error ("Doing vfork", Qnil);
2274 }
2275 #endif /* not VMS */
2276
2277 \f
2278 #ifdef HAVE_SOCKETS
2279
2280 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2281 The address family of sa is not included in the result. */
2282
2283 static Lisp_Object
2284 conv_sockaddr_to_lisp (sa, len)
2285 struct sockaddr *sa;
2286 int len;
2287 {
2288 Lisp_Object address;
2289 int i;
2290 unsigned char *cp;
2291 register struct Lisp_Vector *p;
2292
2293 switch (sa->sa_family)
2294 {
2295 case AF_INET:
2296 {
2297 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2298 len = sizeof (sin->sin_addr) + 1;
2299 address = Fmake_vector (make_number (len), Qnil);
2300 p = XVECTOR (address);
2301 p->contents[--len] = make_number (ntohs (sin->sin_port));
2302 cp = (unsigned char *)&sin->sin_addr;
2303 break;
2304 }
2305 #ifdef AF_INET6
2306 case AF_INET6:
2307 {
2308 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2309 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2310 len = sizeof (sin6->sin6_addr)/2 + 1;
2311 address = Fmake_vector (make_number (len), Qnil);
2312 p = XVECTOR (address);
2313 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2314 for (i = 0; i < len; i++)
2315 p->contents[i] = make_number (ntohs (ip6[i]));
2316 return address;
2317 }
2318 #endif
2319 #ifdef HAVE_LOCAL_SOCKETS
2320 case AF_LOCAL:
2321 {
2322 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2323 for (i = 0; i < sizeof (sockun->sun_path); i++)
2324 if (sockun->sun_path[i] == 0)
2325 break;
2326 return make_unibyte_string (sockun->sun_path, i);
2327 }
2328 #endif
2329 default:
2330 len -= sizeof (sa->sa_family);
2331 address = Fcons (make_number (sa->sa_family),
2332 Fmake_vector (make_number (len), Qnil));
2333 p = XVECTOR (XCDR (address));
2334 cp = (unsigned char *) sa + sizeof (sa->sa_family);
2335 break;
2336 }
2337
2338 i = 0;
2339 while (i < len)
2340 p->contents[i++] = make_number (*cp++);
2341
2342 return address;
2343 }
2344
2345
2346 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2347
2348 static int
2349 get_lisp_to_sockaddr_size (address, familyp)
2350 Lisp_Object address;
2351 int *familyp;
2352 {
2353 register struct Lisp_Vector *p;
2354
2355 if (VECTORP (address))
2356 {
2357 p = XVECTOR (address);
2358 if (p->size == 5)
2359 {
2360 *familyp = AF_INET;
2361 return sizeof (struct sockaddr_in);
2362 }
2363 #ifdef AF_INET6
2364 else if (p->size == 9)
2365 {
2366 *familyp = AF_INET6;
2367 return sizeof (struct sockaddr_in6);
2368 }
2369 #endif
2370 }
2371 #ifdef HAVE_LOCAL_SOCKETS
2372 else if (STRINGP (address))
2373 {
2374 *familyp = AF_LOCAL;
2375 return sizeof (struct sockaddr_un);
2376 }
2377 #endif
2378 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2379 {
2380 struct sockaddr *sa;
2381 *familyp = XINT (XCAR (address));
2382 p = XVECTOR (XCDR (address));
2383 return p->size + sizeof (sa->sa_family);
2384 }
2385 return 0;
2386 }
2387
2388 /* Convert an address object (vector or string) to an internal sockaddr.
2389
2390 The address format has been basically validated by
2391 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2392 it could have come from user data. So if FAMILY is not valid,
2393 we return after zeroing *SA. */
2394
2395 static void
2396 conv_lisp_to_sockaddr (family, address, sa, len)
2397 int family;
2398 Lisp_Object address;
2399 struct sockaddr *sa;
2400 int len;
2401 {
2402 register struct Lisp_Vector *p;
2403 register unsigned char *cp = NULL;
2404 register int i;
2405
2406 bzero (sa, len);
2407
2408 if (VECTORP (address))
2409 {
2410 p = XVECTOR (address);
2411 if (family == AF_INET)
2412 {
2413 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2414 len = sizeof (sin->sin_addr) + 1;
2415 i = XINT (p->contents[--len]);
2416 sin->sin_port = htons (i);
2417 cp = (unsigned char *)&sin->sin_addr;
2418 sa->sa_family = family;
2419 }
2420 #ifdef AF_INET6
2421 else if (family == AF_INET6)
2422 {
2423 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2424 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2425 len = sizeof (sin6->sin6_addr) + 1;
2426 i = XINT (p->contents[--len]);
2427 sin6->sin6_port = htons (i);
2428 for (i = 0; i < len; i++)
2429 if (INTEGERP (p->contents[i]))
2430 {
2431 int j = XFASTINT (p->contents[i]) & 0xffff;
2432 ip6[i] = ntohs (j);
2433 }
2434 sa->sa_family = family;
2435 }
2436 #endif
2437 return;
2438 }
2439 else if (STRINGP (address))
2440 {
2441 #ifdef HAVE_LOCAL_SOCKETS
2442 if (family == AF_LOCAL)
2443 {
2444 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2445 cp = SDATA (address);
2446 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2447 sockun->sun_path[i] = *cp++;
2448 sa->sa_family = family;
2449 }
2450 #endif
2451 return;
2452 }
2453 else
2454 {
2455 p = XVECTOR (XCDR (address));
2456 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2457 }
2458
2459 for (i = 0; i < len; i++)
2460 if (INTEGERP (p->contents[i]))
2461 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2462 }
2463
2464 #ifdef DATAGRAM_SOCKETS
2465 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2466 1, 1, 0,
2467 doc: /* Get the current datagram address associated with PROCESS. */)
2468 (process)
2469 Lisp_Object process;
2470 {
2471 int channel;
2472
2473 CHECK_PROCESS (process);
2474
2475 if (!DATAGRAM_CONN_P (process))
2476 return Qnil;
2477
2478 channel = XPROCESS (process)->infd;
2479 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2480 datagram_address[channel].len);
2481 }
2482
2483 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2484 2, 2, 0,
2485 doc: /* Set the datagram address for PROCESS to ADDRESS.
2486 Returns nil upon error setting address, ADDRESS otherwise. */)
2487 (process, address)
2488 Lisp_Object process, address;
2489 {
2490 int channel;
2491 int family, len;
2492
2493 CHECK_PROCESS (process);
2494
2495 if (!DATAGRAM_CONN_P (process))
2496 return Qnil;
2497
2498 channel = XPROCESS (process)->infd;
2499
2500 len = get_lisp_to_sockaddr_size (address, &family);
2501 if (datagram_address[channel].len != len)
2502 return Qnil;
2503 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2504 return address;
2505 }
2506 #endif
2507 \f
2508
2509 static struct socket_options {
2510 /* The name of this option. Should be lowercase version of option
2511 name without SO_ prefix. */
2512 char *name;
2513 /* Option level SOL_... */
2514 int optlevel;
2515 /* Option number SO_... */
2516 int optnum;
2517 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2518 enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
2519 } socket_options[] =
2520 {
2521 #ifdef SO_BINDTODEVICE
2522 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2523 #endif
2524 #ifdef SO_BROADCAST
2525 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2526 #endif
2527 #ifdef SO_DONTROUTE
2528 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2529 #endif
2530 #ifdef SO_KEEPALIVE
2531 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2532 #endif
2533 #ifdef SO_LINGER
2534 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2535 #endif
2536 #ifdef SO_OOBINLINE
2537 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2538 #endif
2539 #ifdef SO_PRIORITY
2540 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2541 #endif
2542 #ifdef SO_REUSEADDR
2543 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2544 #endif
2545 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2546 };
2547
2548 /* Set option OPT to value VAL on socket S.
2549
2550 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2551 Signals an error if setting a known option fails.
2552 */
2553
2554 static int
2555 set_socket_option (s, opt, val)
2556 int s;
2557 Lisp_Object opt, val;
2558 {
2559 char *name;
2560 struct socket_options *sopt;
2561 int ret = 0;
2562
2563 CHECK_SYMBOL (opt);
2564
2565 name = (char *) SDATA (SYMBOL_NAME (opt));
2566 for (sopt = socket_options; sopt->name; sopt++)
2567 if (strcmp (name, sopt->name) == 0)
2568 break;
2569
2570 switch (sopt->opttype)
2571 {
2572 case SOPT_BOOL:
2573 {
2574 int optval;
2575 optval = NILP (val) ? 0 : 1;
2576 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2577 &optval, sizeof (optval));
2578 break;
2579 }
2580
2581 case SOPT_INT:
2582 {
2583 int optval;
2584 if (INTEGERP (val))
2585 optval = XINT (val);
2586 else
2587 error ("Bad option value for %s", name);
2588 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2589 &optval, sizeof (optval));
2590 break;
2591 }
2592
2593 #ifdef SO_BINDTODEVICE
2594 case SOPT_IFNAME:
2595 {
2596 char devname[IFNAMSIZ+1];
2597
2598 /* This is broken, at least in the Linux 2.4 kernel.
2599 To unbind, the arg must be a zero integer, not the empty string.
2600 This should work on all systems. KFS. 2003-09-23. */
2601 bzero (devname, sizeof devname);
2602 if (STRINGP (val))
2603 {
2604 char *arg = (char *) SDATA (val);
2605 int len = min (strlen (arg), IFNAMSIZ);
2606 bcopy (arg, devname, len);
2607 }
2608 else if (!NILP (val))
2609 error ("Bad option value for %s", name);
2610 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2611 devname, IFNAMSIZ);
2612 break;
2613 }
2614 #endif
2615
2616 #ifdef SO_LINGER
2617 case SOPT_LINGER:
2618 {
2619 struct linger linger;
2620
2621 linger.l_onoff = 1;
2622 linger.l_linger = 0;
2623 if (INTEGERP (val))
2624 linger.l_linger = XINT (val);
2625 else
2626 linger.l_onoff = NILP (val) ? 0 : 1;
2627 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2628 &linger, sizeof (linger));
2629 break;
2630 }
2631 #endif
2632
2633 default:
2634 return 0;
2635 }
2636
2637 if (ret < 0)
2638 report_file_error ("Cannot set network option",
2639 Fcons (opt, Fcons (val, Qnil)));
2640 return (1 << sopt->optbit);
2641 }
2642
2643
2644 DEFUN ("set-network-process-option",
2645 Fset_network_process_option, Sset_network_process_option,
2646 3, 4, 0,
2647 doc: /* For network process PROCESS set option OPTION to value VALUE.
2648 See `make-network-process' for a list of options and values.
2649 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2650 OPTION is not a supported option, return nil instead; otherwise return t. */)
2651 (process, option, value, no_error)
2652 Lisp_Object process, option, value;
2653 Lisp_Object no_error;
2654 {
2655 int s;
2656 struct Lisp_Process *p;
2657
2658 CHECK_PROCESS (process);
2659 p = XPROCESS (process);
2660 if (!NETCONN1_P (p))
2661 error ("Process is not a network process");
2662
2663 s = p->infd;
2664 if (s < 0)
2665 error ("Process is not running");
2666
2667 if (set_socket_option (s, option, value))
2668 {
2669 p->childp = Fplist_put (p->childp, option, value);
2670 return Qt;
2671 }
2672
2673 if (NILP (no_error))
2674 error ("Unknown or unsupported option");
2675
2676 return Qnil;
2677 }
2678
2679 \f
2680 #ifdef HAVE_SERIAL
2681 DEFUN ("serial-process-configure",
2682 Fserial_process_configure,
2683 Sserial_process_configure,
2684 0, MANY, 0,
2685 doc: /* Configure speed, bytesize, etc. of a serial process.
2686
2687 Arguments are specified as keyword/argument pairs. Attributes that
2688 are not given are re-initialized from the process's current
2689 configuration (available via the function `process-contact') or set to
2690 reasonable default values. The following arguments are defined:
2691
2692 :process PROCESS
2693 :name NAME
2694 :buffer BUFFER
2695 :port PORT
2696 -- Any of these arguments can be given to identify the process that is
2697 to be configured. If none of these arguments is given, the current
2698 buffer's process is used.
2699
2700 :speed SPEED -- SPEED is the speed of the serial port in bits per
2701 second, also called baud rate. Any value can be given for SPEED, but
2702 most serial ports work only at a few defined values between 1200 and
2703 115200, with 9600 being the most common value. If SPEED is nil, the
2704 serial port is not configured any further, i.e., all other arguments
2705 are ignored. This may be useful for special serial ports such as
2706 Bluetooth-to-serial converters which can only be configured through AT
2707 commands. A value of nil for SPEED can be used only when passed
2708 through `make-serial-process' or `serial-term'.
2709
2710 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2711 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2712
2713 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2714 `odd' (use odd parity), or the symbol `even' (use even parity). If
2715 PARITY is not given, no parity is used.
2716
2717 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2718 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2719 is not given or nil, 1 stopbit is used.
2720
2721 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2722 flowcontrol to be used, which is either nil (don't use flowcontrol),
2723 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2724 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2725 flowcontrol is used.
2726
2727 `serial-process-configure' is called by `make-serial-process' for the
2728 initial configuration of the serial port.
2729
2730 Examples:
2731
2732 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2733
2734 \(serial-process-configure
2735 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2736
2737 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2738
2739 usage: (serial-process-configure &rest ARGS) */)
2740 (nargs, args)
2741 int nargs;
2742 Lisp_Object *args;
2743 {
2744 struct Lisp_Process *p;
2745 Lisp_Object contact = Qnil;
2746 Lisp_Object proc = Qnil;
2747 struct gcpro gcpro1;
2748
2749 contact = Flist (nargs, args);
2750 GCPRO1 (contact);
2751
2752 proc = Fplist_get (contact, QCprocess);
2753 if (NILP (proc))
2754 proc = Fplist_get (contact, QCname);
2755 if (NILP (proc))
2756 proc = Fplist_get (contact, QCbuffer);
2757 if (NILP (proc))
2758 proc = Fplist_get (contact, QCport);
2759 proc = get_process (proc);
2760 p = XPROCESS (proc);
2761 if (!EQ (p->type, Qserial))
2762 error ("Not a serial process");
2763
2764 if (NILP (Fplist_get (p->childp, QCspeed)))
2765 {
2766 UNGCPRO;
2767 return Qnil;
2768 }
2769
2770 serial_configure (p, contact);
2771
2772 UNGCPRO;
2773 return Qnil;
2774 }
2775 #endif /* HAVE_SERIAL */
2776
2777 #ifdef HAVE_SERIAL
2778 /* Used by make-serial-process to recover from errors. */
2779 Lisp_Object make_serial_process_unwind (Lisp_Object proc)
2780 {
2781 if (!PROCESSP (proc))
2782 abort ();
2783 remove_process (proc);
2784 return Qnil;
2785 }
2786 #endif /* HAVE_SERIAL */
2787
2788 #ifdef HAVE_SERIAL
2789 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2790 0, MANY, 0,
2791 doc: /* Create and return a serial port process.
2792
2793 In Emacs, serial port connections are represented by process objects,
2794 so input and output work as for subprocesses, and `delete-process'
2795 closes a serial port connection. However, a serial process has no
2796 process id, it cannot be signaled, and the status codes are different
2797 from normal processes.
2798
2799 `make-serial-process' creates a process and a buffer, on which you
2800 probably want to use `process-send-string'. Try \\[serial-term] for
2801 an interactive terminal. See below for examples.
2802
2803 Arguments are specified as keyword/argument pairs. The following
2804 arguments are defined:
2805
2806 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2807 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2808 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2809 the backslashes in strings).
2810
2811 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2812 which is called by `make-serial-process'.
2813
2814 :name NAME -- NAME is the name of the process. If NAME is not given,
2815 the value of PORT is used.
2816
2817 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2818 with the process. Process output goes at the end of that buffer,
2819 unless you specify an output stream or filter function to handle the
2820 output. If BUFFER is not given, the value of NAME is used.
2821
2822 :coding CODING -- If CODING is a symbol, it specifies the coding
2823 system used for both reading and writing for this process. If CODING
2824 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2825 ENCODING is used for writing.
2826
2827 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2828 the process is running. If BOOL is not given, query before exiting.
2829
2830 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2831 In the stopped state, a serial process does not accept incoming data,
2832 but you can send outgoing data. The stopped state is cleared by
2833 `continue-process' and set by `stop-process'.
2834
2835 :filter FILTER -- Install FILTER as the process filter.
2836
2837 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2838
2839 :plist PLIST -- Install PLIST as the initial plist of the process.
2840
2841 :speed
2842 :bytesize
2843 :parity
2844 :stopbits
2845 :flowcontrol
2846 -- These arguments are handled by `serial-process-configure', which is
2847 called by `make-serial-process'.
2848
2849 The original argument list, possibly modified by later configuration,
2850 is available via the function `process-contact'.
2851
2852 Examples:
2853
2854 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2855
2856 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2857
2858 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2859
2860 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2861
2862 usage: (make-serial-process &rest ARGS) */)
2863 (nargs, args)
2864 int nargs;
2865 Lisp_Object *args;
2866 {
2867 int fd = -1;
2868 Lisp_Object proc, contact, port;
2869 struct Lisp_Process *p;
2870 struct gcpro gcpro1;
2871 Lisp_Object name, buffer;
2872 Lisp_Object tem, val;
2873 int specpdl_count = -1;
2874
2875 if (nargs == 0)
2876 return Qnil;
2877
2878 contact = Flist (nargs, args);
2879 GCPRO1 (contact);
2880
2881 port = Fplist_get (contact, QCport);
2882 if (NILP (port))
2883 error ("No port specified");
2884 CHECK_STRING (port);
2885
2886 if (NILP (Fplist_member (contact, QCspeed)))
2887 error (":speed not specified");
2888 if (!NILP (Fplist_get (contact, QCspeed)))
2889 CHECK_NUMBER (Fplist_get (contact, QCspeed));
2890
2891 name = Fplist_get (contact, QCname);
2892 if (NILP (name))
2893 name = port;
2894 CHECK_STRING (name);
2895 proc = make_process (name);
2896 specpdl_count = SPECPDL_INDEX ();
2897 record_unwind_protect (make_serial_process_unwind, proc);
2898 p = XPROCESS (proc);
2899
2900 fd = serial_open ((char*) SDATA (port));
2901 p->infd = fd;
2902 p->outfd = fd;
2903 if (fd > max_process_desc)
2904 max_process_desc = fd;
2905 chan_process[fd] = proc;
2906
2907 buffer = Fplist_get (contact, QCbuffer);
2908 if (NILP (buffer))
2909 buffer = name;
2910 buffer = Fget_buffer_create (buffer);
2911 p->buffer = buffer;
2912
2913 p->childp = contact;
2914 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
2915 p->type = Qserial;
2916 p->sentinel = Fplist_get (contact, QCsentinel);
2917 p->filter = Fplist_get (contact, QCfilter);
2918 p->log = Qnil;
2919 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2920 p->kill_without_query = 1;
2921 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2922 p->command = Qt;
2923 p->pty_flag = 0;
2924
2925 if (!EQ (p->command, Qt))
2926 {
2927 FD_SET (fd, &input_wait_mask);
2928 FD_SET (fd, &non_keyboard_wait_mask);
2929 }
2930
2931 if (BUFFERP (buffer))
2932 {
2933 set_marker_both (p->mark, buffer,
2934 BUF_ZV (XBUFFER (buffer)),
2935 BUF_ZV_BYTE (XBUFFER (buffer)));
2936 }
2937
2938 tem = Fplist_member (contact, QCcoding);
2939 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
2940 tem = Qnil;
2941
2942 val = Qnil;
2943 if (!NILP (tem))
2944 {
2945 val = XCAR (XCDR (tem));
2946 if (CONSP (val))
2947 val = XCAR (val);
2948 }
2949 else if (!NILP (Vcoding_system_for_read))
2950 val = Vcoding_system_for_read;
2951 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2952 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
2953 val = Qnil;
2954 p->decode_coding_system = val;
2955
2956 val = Qnil;
2957 if (!NILP (tem))
2958 {
2959 val = XCAR (XCDR (tem));
2960 if (CONSP (val))
2961 val = XCDR (val);
2962 }
2963 else if (!NILP (Vcoding_system_for_write))
2964 val = Vcoding_system_for_write;
2965 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2966 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
2967 val = Qnil;
2968 p->encode_coding_system = val;
2969
2970 setup_process_coding_systems (proc);
2971 p->decoding_buf = make_uninit_string (0);
2972 p->decoding_carryover = 0;
2973 p->encoding_buf = make_uninit_string (0);
2974 p->inherit_coding_system_flag
2975 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
2976
2977 Fserial_process_configure(nargs, args);
2978
2979 specpdl_ptr = specpdl + specpdl_count;
2980
2981 UNGCPRO;
2982 return proc;
2983 }
2984 #endif /* HAVE_SERIAL */
2985
2986 /* Create a network stream/datagram client/server process. Treated
2987 exactly like a normal process when reading and writing. Primary
2988 differences are in status display and process deletion. A network
2989 connection has no PID; you cannot signal it. All you can do is
2990 stop/continue it and deactivate/close it via delete-process */
2991
2992 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2993 0, MANY, 0,
2994 doc: /* Create and return a network server or client process.
2995
2996 In Emacs, network connections are represented by process objects, so
2997 input and output work as for subprocesses and `delete-process' closes
2998 a network connection. However, a network process has no process id,
2999 it cannot be signaled, and the status codes are different from normal
3000 processes.
3001
3002 Arguments are specified as keyword/argument pairs. The following
3003 arguments are defined:
3004
3005 :name NAME -- NAME is name for process. It is modified if necessary
3006 to make it unique.
3007
3008 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3009 with the process. Process output goes at end of that buffer, unless
3010 you specify an output stream or filter function to handle the output.
3011 BUFFER may be also nil, meaning that this process is not associated
3012 with any buffer.
3013
3014 :host HOST -- HOST is name of the host to connect to, or its IP
3015 address. The symbol `local' specifies the local host. If specified
3016 for a server process, it must be a valid name or address for the local
3017 host, and only clients connecting to that address will be accepted.
3018
3019 :service SERVICE -- SERVICE is name of the service desired, or an
3020 integer specifying a port number to connect to. If SERVICE is t,
3021 a random port number is selected for the server. (If Emacs was
3022 compiled with getaddrinfo, a port number can also be specified as a
3023 string, e.g. "80", as well as an integer. This is not portable.)
3024
3025 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3026 stream type connection, `datagram' creates a datagram type connection.
3027
3028 :family FAMILY -- FAMILY is the address (and protocol) family for the
3029 service specified by HOST and SERVICE. The default (nil) is to use
3030 whatever address family (IPv4 or IPv6) that is defined for the host
3031 and port number specified by HOST and SERVICE. Other address families
3032 supported are:
3033 local -- for a local (i.e. UNIX) address specified by SERVICE.
3034 ipv4 -- use IPv4 address family only.
3035 ipv6 -- use IPv6 address family only.
3036
3037 :local ADDRESS -- ADDRESS is the local address used for the connection.
3038 This parameter is ignored when opening a client process. When specified
3039 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3040
3041 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3042 connection. This parameter is ignored when opening a stream server
3043 process. For a datagram server process, it specifies the initial
3044 setting of the remote datagram address. When specified for a client
3045 process, the FAMILY, HOST, and SERVICE args are ignored.
3046
3047 The format of ADDRESS depends on the address family:
3048 - An IPv4 address is represented as an vector of integers [A B C D P]
3049 corresponding to numeric IP address A.B.C.D and port number P.
3050 - A local address is represented as a string with the address in the
3051 local address space.
3052 - An "unsupported family" address is represented by a cons (F . AV)
3053 where F is the family number and AV is a vector containing the socket
3054 address data with one element per address data byte. Do not rely on
3055 this format in portable code, as it may depend on implementation
3056 defined constants, data sizes, and data structure alignment.
3057
3058 :coding CODING -- If CODING is a symbol, it specifies the coding
3059 system used for both reading and writing for this process. If CODING
3060 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3061 ENCODING is used for writing.
3062
3063 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
3064 return without waiting for the connection to complete; instead, the
3065 sentinel function will be called with second arg matching "open" (if
3066 successful) or "failed" when the connect completes. Default is to use
3067 a blocking connect (i.e. wait) for stream type connections.
3068
3069 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3070 running when Emacs is exited.
3071
3072 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3073 In the stopped state, a server process does not accept new
3074 connections, and a client process does not handle incoming traffic.
3075 The stopped state is cleared by `continue-process' and set by
3076 `stop-process'.
3077
3078 :filter FILTER -- Install FILTER as the process filter.
3079
3080 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3081 process filter are multibyte, otherwise they are unibyte.
3082 If this keyword is not specified, the strings are multibyte if
3083 `default-enable-multibyte-characters' is non-nil.
3084
3085 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3086
3087 :log LOG -- Install LOG as the server process log function. This
3088 function is called when the server accepts a network connection from a
3089 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3090 is the server process, CLIENT is the new process for the connection,
3091 and MESSAGE is a string.
3092
3093 :plist PLIST -- Install PLIST as the new process' initial plist.
3094
3095 :server QLEN -- if QLEN is non-nil, create a server process for the
3096 specified FAMILY, SERVICE, and connection type (stream or datagram).
3097 If QLEN is an integer, it is used as the max. length of the server's
3098 pending connection queue (also known as the backlog); the default
3099 queue length is 5. Default is to create a client process.
3100
3101 The following network options can be specified for this connection:
3102
3103 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3104 :dontroute BOOL -- Only send to directly connected hosts.
3105 :keepalive BOOL -- Send keep-alive messages on network stream.
3106 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3107 :oobinline BOOL -- Place out-of-band data in receive data stream.
3108 :priority INT -- Set protocol defined priority for sent packets.
3109 :reuseaddr BOOL -- Allow reusing a recently used local address
3110 (this is allowed by default for a server process).
3111 :bindtodevice NAME -- bind to interface NAME. Using this may require
3112 special privileges on some systems.
3113
3114 Consult the relevant system programmer's manual pages for more
3115 information on using these options.
3116
3117
3118 A server process will listen for and accept connections from clients.
3119 When a client connection is accepted, a new network process is created
3120 for the connection with the following parameters:
3121
3122 - The client's process name is constructed by concatenating the server
3123 process' NAME and a client identification string.
3124 - If the FILTER argument is non-nil, the client process will not get a
3125 separate process buffer; otherwise, the client's process buffer is a newly
3126 created buffer named after the server process' BUFFER name or process
3127 NAME concatenated with the client identification string.
3128 - The connection type and the process filter and sentinel parameters are
3129 inherited from the server process' TYPE, FILTER and SENTINEL.
3130 - The client process' contact info is set according to the client's
3131 addressing information (typically an IP address and a port number).
3132 - The client process' plist is initialized from the server's plist.
3133
3134 Notice that the FILTER and SENTINEL args are never used directly by
3135 the server process. Also, the BUFFER argument is not used directly by
3136 the server process, but via the optional :log function, accepted (and
3137 failed) connections may be logged in the server process' buffer.
3138
3139 The original argument list, modified with the actual connection
3140 information, is available via the `process-contact' function.
3141
3142 usage: (make-network-process &rest ARGS) */)
3143 (nargs, args)
3144 int nargs;
3145 Lisp_Object *args;
3146 {
3147 Lisp_Object proc;
3148 Lisp_Object contact;
3149 struct Lisp_Process *p;
3150 #ifdef HAVE_GETADDRINFO
3151 struct addrinfo ai, *res, *lres;
3152 struct addrinfo hints;
3153 char *portstring, portbuf[128];
3154 #else /* HAVE_GETADDRINFO */
3155 struct _emacs_addrinfo
3156 {
3157 int ai_family;
3158 int ai_socktype;
3159 int ai_protocol;
3160 int ai_addrlen;
3161 struct sockaddr *ai_addr;
3162 struct _emacs_addrinfo *ai_next;
3163 } ai, *res, *lres;
3164 #endif /* HAVE_GETADDRINFO */
3165 struct sockaddr_in address_in;
3166 #ifdef HAVE_LOCAL_SOCKETS
3167 struct sockaddr_un address_un;
3168 #endif
3169 int port;
3170 int ret = 0;
3171 int xerrno = 0;
3172 int s = -1, outch, inch;
3173 struct gcpro gcpro1;
3174 int count = SPECPDL_INDEX ();
3175 int count1;
3176 Lisp_Object QCaddress; /* one of QClocal or QCremote */
3177 Lisp_Object tem;
3178 Lisp_Object name, buffer, host, service, address;
3179 Lisp_Object filter, sentinel;
3180 int is_non_blocking_client = 0;
3181 int is_server = 0, backlog = 5;
3182 int socktype;
3183 int family = -1;
3184
3185 if (nargs == 0)
3186 return Qnil;
3187
3188 /* Save arguments for process-contact and clone-process. */
3189 contact = Flist (nargs, args);
3190 GCPRO1 (contact);
3191
3192 #ifdef WINDOWSNT
3193 /* Ensure socket support is loaded if available. */
3194 init_winsock (TRUE);
3195 #endif
3196
3197 /* :type TYPE (nil: stream, datagram */
3198 tem = Fplist_get (contact, QCtype);
3199 if (NILP (tem))
3200 socktype = SOCK_STREAM;
3201 #ifdef DATAGRAM_SOCKETS
3202 else if (EQ (tem, Qdatagram))
3203 socktype = SOCK_DGRAM;
3204 #endif
3205 else
3206 error ("Unsupported connection type");
3207
3208 /* :server BOOL */
3209 tem = Fplist_get (contact, QCserver);
3210 if (!NILP (tem))
3211 {
3212 /* Don't support network sockets when non-blocking mode is
3213 not available, since a blocked Emacs is not useful. */
3214 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
3215 error ("Network servers not supported");
3216 #else
3217 is_server = 1;
3218 if (INTEGERP (tem))
3219 backlog = XINT (tem);
3220 #endif
3221 }
3222
3223 /* Make QCaddress an alias for :local (server) or :remote (client). */
3224 QCaddress = is_server ? QClocal : QCremote;
3225
3226 /* :nowait BOOL */
3227 if (!is_server && socktype == SOCK_STREAM
3228 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
3229 {
3230 #ifndef NON_BLOCKING_CONNECT
3231 error ("Non-blocking connect not supported");
3232 #else
3233 is_non_blocking_client = 1;
3234 #endif
3235 }
3236
3237 name = Fplist_get (contact, QCname);
3238 buffer = Fplist_get (contact, QCbuffer);
3239 filter = Fplist_get (contact, QCfilter);
3240 sentinel = Fplist_get (contact, QCsentinel);
3241
3242 CHECK_STRING (name);
3243
3244 #ifdef TERM
3245 /* Let's handle TERM before things get complicated ... */
3246 host = Fplist_get (contact, QChost);
3247 CHECK_STRING (host);
3248
3249 service = Fplist_get (contact, QCservice);
3250 if (INTEGERP (service))
3251 port = htons ((unsigned short) XINT (service));
3252 else
3253 {
3254 struct servent *svc_info;
3255 CHECK_STRING (service);
3256 svc_info = getservbyname (SDATA (service), "tcp");
3257 if (svc_info == 0)
3258 error ("Unknown service: %s", SDATA (service));
3259 port = svc_info->s_port;
3260 }
3261
3262 s = connect_server (0);
3263 if (s < 0)
3264 report_file_error ("error creating socket", Fcons (name, Qnil));
3265 send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
3266 send_command (s, C_DUMB, 1, 0);
3267
3268 #else /* not TERM */
3269
3270 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
3271 ai.ai_socktype = socktype;
3272 ai.ai_protocol = 0;
3273 ai.ai_next = NULL;
3274 res = &ai;
3275
3276 /* :local ADDRESS or :remote ADDRESS */
3277 address = Fplist_get (contact, QCaddress);
3278 if (!NILP (address))
3279 {
3280 host = service = Qnil;
3281
3282 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
3283 error ("Malformed :address");
3284 ai.ai_family = family;
3285 ai.ai_addr = alloca (ai.ai_addrlen);
3286 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
3287 goto open_socket;
3288 }
3289
3290 /* :family FAMILY -- nil (for Inet), local, or integer. */
3291 tem = Fplist_get (contact, QCfamily);
3292 if (NILP (tem))
3293 {
3294 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3295 family = AF_UNSPEC;
3296 #else
3297 family = AF_INET;
3298 #endif
3299 }
3300 #ifdef HAVE_LOCAL_SOCKETS
3301 else if (EQ (tem, Qlocal))
3302 family = AF_LOCAL;
3303 #endif
3304 #ifdef AF_INET6
3305 else if (EQ (tem, Qipv6))
3306 family = AF_INET6;
3307 #endif
3308 else if (EQ (tem, Qipv4))
3309 family = AF_INET;
3310 else if (INTEGERP (tem))
3311 family = XINT (tem);
3312 else
3313 error ("Unknown address family");
3314
3315 ai.ai_family = family;
3316
3317 /* :service SERVICE -- string, integer (port number), or t (random port). */
3318 service = Fplist_get (contact, QCservice);
3319
3320 #ifdef HAVE_LOCAL_SOCKETS
3321 if (family == AF_LOCAL)
3322 {
3323 /* Host is not used. */
3324 host = Qnil;
3325 CHECK_STRING (service);
3326 bzero (&address_un, sizeof address_un);
3327 address_un.sun_family = AF_LOCAL;
3328 strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
3329 ai.ai_addr = (struct sockaddr *) &address_un;
3330 ai.ai_addrlen = sizeof address_un;
3331 goto open_socket;
3332 }
3333 #endif
3334
3335 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3336 host = Fplist_get (contact, QChost);
3337 if (!NILP (host))
3338 {
3339 if (EQ (host, Qlocal))
3340 host = build_string ("localhost");
3341 CHECK_STRING (host);
3342 }
3343
3344 /* Slow down polling to every ten seconds.
3345 Some kernels have a bug which causes retrying connect to fail
3346 after a connect. Polling can interfere with gethostbyname too. */
3347 #ifdef POLL_FOR_INPUT
3348 if (socktype == SOCK_STREAM)
3349 {
3350 record_unwind_protect (unwind_stop_other_atimers, Qnil);
3351 bind_polling_period (10);
3352 }
3353 #endif
3354
3355 #ifdef HAVE_GETADDRINFO
3356 /* If we have a host, use getaddrinfo to resolve both host and service.
3357 Otherwise, use getservbyname to lookup the service. */
3358 if (!NILP (host))
3359 {
3360
3361 /* SERVICE can either be a string or int.
3362 Convert to a C string for later use by getaddrinfo. */
3363 if (EQ (service, Qt))
3364 portstring = "0";
3365 else if (INTEGERP (service))
3366 {
3367 sprintf (portbuf, "%ld", (long) XINT (service));
3368 portstring = portbuf;
3369 }
3370 else
3371 {
3372 CHECK_STRING (service);
3373 portstring = SDATA (service);
3374 }
3375
3376 immediate_quit = 1;
3377 QUIT;
3378 memset (&hints, 0, sizeof (hints));
3379 hints.ai_flags = 0;
3380 hints.ai_family = family;
3381 hints.ai_socktype = socktype;
3382 hints.ai_protocol = 0;
3383
3384 #ifdef HAVE_RES_INIT
3385 res_init ();
3386 #endif
3387
3388 ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
3389 if (ret)
3390 #ifdef HAVE_GAI_STRERROR
3391 error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
3392 #else
3393 error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
3394 #endif
3395 immediate_quit = 0;
3396
3397 goto open_socket;
3398 }
3399 #endif /* HAVE_GETADDRINFO */
3400
3401 /* We end up here if getaddrinfo is not defined, or in case no hostname
3402 has been specified (e.g. for a local server process). */
3403
3404 if (EQ (service, Qt))
3405 port = 0;
3406 else if (INTEGERP (service))
3407 port = htons ((unsigned short) XINT (service));
3408 else
3409 {
3410 struct servent *svc_info;
3411 CHECK_STRING (service);
3412 svc_info = getservbyname (SDATA (service),
3413 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
3414 if (svc_info == 0)
3415 error ("Unknown service: %s", SDATA (service));
3416 port = svc_info->s_port;
3417 }
3418
3419 bzero (&address_in, sizeof address_in);
3420 address_in.sin_family = family;
3421 address_in.sin_addr.s_addr = INADDR_ANY;
3422 address_in.sin_port = port;
3423
3424 #ifndef HAVE_GETADDRINFO
3425 if (!NILP (host))
3426 {
3427 struct hostent *host_info_ptr;
3428
3429 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3430 as it may `hang' Emacs for a very long time. */
3431 immediate_quit = 1;
3432 QUIT;
3433
3434 #ifdef HAVE_RES_INIT
3435 res_init ();
3436 #endif
3437
3438 host_info_ptr = gethostbyname (SDATA (host));
3439 immediate_quit = 0;
3440
3441 if (host_info_ptr)
3442 {
3443 bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
3444 host_info_ptr->h_length);
3445 family = host_info_ptr->h_addrtype;
3446 address_in.sin_family = family;
3447 }
3448 else
3449 /* Attempt to interpret host as numeric inet address */
3450 {
3451 unsigned long numeric_addr;
3452 numeric_addr = inet_addr ((char *) SDATA (host));
3453 if (numeric_addr == -1)
3454 error ("Unknown host \"%s\"", SDATA (host));
3455
3456 bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
3457 sizeof (address_in.sin_addr));
3458 }
3459
3460 }
3461 #endif /* not HAVE_GETADDRINFO */
3462
3463 ai.ai_family = family;
3464 ai.ai_addr = (struct sockaddr *) &address_in;
3465 ai.ai_addrlen = sizeof address_in;
3466
3467 open_socket:
3468
3469 /* Do this in case we never enter the for-loop below. */
3470 count1 = SPECPDL_INDEX ();
3471 s = -1;
3472
3473 for (lres = res; lres; lres = lres->ai_next)
3474 {
3475 int optn, optbits;
3476
3477 retry_connect:
3478
3479 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
3480 if (s < 0)
3481 {
3482 xerrno = errno;
3483 continue;
3484 }
3485
3486 #ifdef DATAGRAM_SOCKETS
3487 if (!is_server && socktype == SOCK_DGRAM)
3488 break;
3489 #endif /* DATAGRAM_SOCKETS */
3490
3491 #ifdef NON_BLOCKING_CONNECT
3492 if (is_non_blocking_client)
3493 {
3494 #ifdef O_NONBLOCK
3495 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3496 #else
3497 ret = fcntl (s, F_SETFL, O_NDELAY);
3498 #endif
3499 if (ret < 0)
3500 {
3501 xerrno = errno;
3502 emacs_close (s);
3503 s = -1;
3504 continue;
3505 }
3506 }
3507 #endif
3508
3509 /* Make us close S if quit. */
3510 record_unwind_protect (close_file_unwind, make_number (s));
3511
3512 /* Parse network options in the arg list.
3513 We simply ignore anything which isn't a known option (including other keywords).
3514 An error is signaled if setting a known option fails. */
3515 for (optn = optbits = 0; optn < nargs-1; optn += 2)
3516 optbits |= set_socket_option (s, args[optn], args[optn+1]);
3517
3518 if (is_server)
3519 {
3520 /* Configure as a server socket. */
3521
3522 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3523 explicit :reuseaddr key to override this. */
3524 #ifdef HAVE_LOCAL_SOCKETS
3525 if (family != AF_LOCAL)
3526 #endif
3527 if (!(optbits & (1 << OPIX_REUSEADDR)))
3528 {
3529 int optval = 1;
3530 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3531 report_file_error ("Cannot set reuse option on server socket", Qnil);
3532 }
3533
3534 if (bind (s, lres->ai_addr, lres->ai_addrlen))
3535 report_file_error ("Cannot bind server socket", Qnil);
3536
3537 #ifdef HAVE_GETSOCKNAME
3538 if (EQ (service, Qt))
3539 {
3540 struct sockaddr_in sa1;
3541 int len1 = sizeof (sa1);
3542 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3543 {
3544 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3545 service = make_number (ntohs (sa1.sin_port));
3546 contact = Fplist_put (contact, QCservice, service);
3547 }
3548 }
3549 #endif
3550
3551 if (socktype == SOCK_STREAM && listen (s, backlog))
3552 report_file_error ("Cannot listen on server socket", Qnil);
3553
3554 break;
3555 }
3556
3557 immediate_quit = 1;
3558 QUIT;
3559
3560 /* This turns off all alarm-based interrupts; the
3561 bind_polling_period call above doesn't always turn all the
3562 short-interval ones off, especially if interrupt_input is
3563 set.
3564
3565 It'd be nice to be able to control the connect timeout
3566 though. Would non-blocking connect calls be portable?
3567
3568 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3569
3570 turn_on_atimers (0);
3571
3572 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
3573 xerrno = errno;
3574
3575 turn_on_atimers (1);
3576
3577 if (ret == 0 || xerrno == EISCONN)
3578 {
3579 /* The unwind-protect will be discarded afterwards.
3580 Likewise for immediate_quit. */
3581 break;
3582 }
3583
3584 #ifdef NON_BLOCKING_CONNECT
3585 #ifdef EINPROGRESS
3586 if (is_non_blocking_client && xerrno == EINPROGRESS)
3587 break;
3588 #else
3589 #ifdef EWOULDBLOCK
3590 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
3591 break;
3592 #endif
3593 #endif
3594 #endif
3595
3596 immediate_quit = 0;
3597
3598 /* Discard the unwind protect closing S. */
3599 specpdl_ptr = specpdl + count1;
3600 emacs_close (s);
3601 s = -1;
3602
3603 if (xerrno == EINTR)
3604 goto retry_connect;
3605 }
3606
3607 if (s >= 0)
3608 {
3609 #ifdef DATAGRAM_SOCKETS
3610 if (socktype == SOCK_DGRAM)
3611 {
3612 if (datagram_address[s].sa)
3613 abort ();
3614 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3615 datagram_address[s].len = lres->ai_addrlen;
3616 if (is_server)
3617 {
3618 Lisp_Object remote;
3619 bzero (datagram_address[s].sa, lres->ai_addrlen);
3620 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3621 {
3622 int rfamily, rlen;
3623 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3624 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3625 conv_lisp_to_sockaddr (rfamily, remote,
3626 datagram_address[s].sa, rlen);
3627 }
3628 }
3629 else
3630 bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
3631 }
3632 #endif
3633 contact = Fplist_put (contact, QCaddress,
3634 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3635 #ifdef HAVE_GETSOCKNAME
3636 if (!is_server)
3637 {
3638 struct sockaddr_in sa1;
3639 int len1 = sizeof (sa1);
3640 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3641 contact = Fplist_put (contact, QClocal,
3642 conv_sockaddr_to_lisp (&sa1, len1));
3643 }
3644 #endif
3645 }
3646
3647 immediate_quit = 0;
3648
3649 #ifdef HAVE_GETADDRINFO
3650 if (res != &ai)
3651 {
3652 BLOCK_INPUT;
3653 freeaddrinfo (res);
3654 UNBLOCK_INPUT;
3655 }
3656 #endif
3657
3658 /* Discard the unwind protect for closing S, if any. */
3659 specpdl_ptr = specpdl + count1;
3660
3661 /* Unwind bind_polling_period and request_sigio. */
3662 unbind_to (count, Qnil);
3663
3664 if (s < 0)
3665 {
3666 /* If non-blocking got this far - and failed - assume non-blocking is
3667 not supported after all. This is probably a wrong assumption, but
3668 the normal blocking calls to open-network-stream handles this error
3669 better. */
3670 if (is_non_blocking_client)
3671 return Qnil;
3672
3673 errno = xerrno;
3674 if (is_server)
3675 report_file_error ("make server process failed", contact);
3676 else
3677 report_file_error ("make client process failed", contact);
3678 }
3679
3680 #endif /* not TERM */
3681
3682 inch = s;
3683 outch = s;
3684
3685 if (!NILP (buffer))
3686 buffer = Fget_buffer_create (buffer);
3687 proc = make_process (name);
3688
3689 chan_process[inch] = proc;
3690
3691 #ifdef O_NONBLOCK
3692 fcntl (inch, F_SETFL, O_NONBLOCK);
3693 #else
3694 #ifdef O_NDELAY
3695 fcntl (inch, F_SETFL, O_NDELAY);
3696 #endif
3697 #endif
3698
3699 p = XPROCESS (proc);
3700
3701 p->childp = contact;
3702 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
3703 p->type = Qnetwork;
3704
3705 p->buffer = buffer;
3706 p->sentinel = sentinel;
3707 p->filter = filter;
3708 p->log = Fplist_get (contact, QClog);
3709 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3710 p->kill_without_query = 1;
3711 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3712 p->command = Qt;
3713 p->pid = 0;
3714 p->infd = inch;
3715 p->outfd = outch;
3716 if (is_server && socktype == SOCK_STREAM)
3717 p->status = Qlisten;
3718
3719 /* Make the process marker point into the process buffer (if any). */
3720 if (BUFFERP (buffer))
3721 set_marker_both (p->mark, buffer,
3722 BUF_ZV (XBUFFER (buffer)),
3723 BUF_ZV_BYTE (XBUFFER (buffer)));
3724
3725 #ifdef NON_BLOCKING_CONNECT
3726 if (is_non_blocking_client)
3727 {
3728 /* We may get here if connect did succeed immediately. However,
3729 in that case, we still need to signal this like a non-blocking
3730 connection. */
3731 p->status = Qconnect;
3732 if (!FD_ISSET (inch, &connect_wait_mask))
3733 {
3734 FD_SET (inch, &connect_wait_mask);
3735 num_pending_connects++;
3736 }
3737 }
3738 else
3739 #endif
3740 /* A server may have a client filter setting of Qt, but it must
3741 still listen for incoming connects unless it is stopped. */
3742 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3743 || (EQ (p->status, Qlisten) && NILP (p->command)))
3744 {
3745 FD_SET (inch, &input_wait_mask);
3746 FD_SET (inch, &non_keyboard_wait_mask);
3747 }
3748
3749 if (inch > max_process_desc)
3750 max_process_desc = inch;
3751
3752 tem = Fplist_member (contact, QCcoding);
3753 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3754 tem = Qnil; /* No error message (too late!). */
3755
3756 {
3757 /* Setup coding systems for communicating with the network stream. */
3758 struct gcpro gcpro1;
3759 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3760 Lisp_Object coding_systems = Qt;
3761 Lisp_Object args[5], val;
3762
3763 if (!NILP (tem))
3764 {
3765 val = XCAR (XCDR (tem));
3766 if (CONSP (val))
3767 val = XCAR (val);
3768 }
3769 else if (!NILP (Vcoding_system_for_read))
3770 val = Vcoding_system_for_read;
3771 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
3772 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
3773 /* We dare not decode end-of-line format by setting VAL to
3774 Qraw_text, because the existing Emacs Lisp libraries
3775 assume that they receive bare code including a sequene of
3776 CR LF. */
3777 val = Qnil;
3778 else
3779 {
3780 if (NILP (host) || NILP (service))
3781 coding_systems = Qnil;
3782 else
3783 {
3784 args[0] = Qopen_network_stream, args[1] = name,
3785 args[2] = buffer, args[3] = host, args[4] = service;
3786 GCPRO1 (proc);
3787 coding_systems = Ffind_operation_coding_system (5, args);
3788 UNGCPRO;
3789 }
3790 if (CONSP (coding_systems))
3791 val = XCAR (coding_systems);
3792 else if (CONSP (Vdefault_process_coding_system))
3793 val = XCAR (Vdefault_process_coding_system);
3794 else
3795 val = Qnil;
3796 }
3797 p->decode_coding_system = val;
3798
3799 if (!NILP (tem))
3800 {
3801 val = XCAR (XCDR (tem));
3802 if (CONSP (val))
3803 val = XCDR (val);
3804 }
3805 else if (!NILP (Vcoding_system_for_write))
3806 val = Vcoding_system_for_write;
3807 else if (NILP (current_buffer->enable_multibyte_characters))
3808 val = Qnil;
3809 else
3810 {
3811 if (EQ (coding_systems, Qt))
3812 {
3813 if (NILP (host) || NILP (service))
3814 coding_systems = Qnil;
3815 else
3816 {
3817 args[0] = Qopen_network_stream, args[1] = name,
3818 args[2] = buffer, args[3] = host, args[4] = service;
3819 GCPRO1 (proc);
3820 coding_systems = Ffind_operation_coding_system (5, args);
3821 UNGCPRO;
3822 }
3823 }
3824 if (CONSP (coding_systems))
3825 val = XCDR (coding_systems);
3826 else if (CONSP (Vdefault_process_coding_system))
3827 val = XCDR (Vdefault_process_coding_system);
3828 else
3829 val = Qnil;
3830 }
3831 p->encode_coding_system = val;
3832 }
3833 setup_process_coding_systems (proc);
3834
3835 p->decoding_buf = make_uninit_string (0);
3836 p->decoding_carryover = 0;
3837 p->encoding_buf = make_uninit_string (0);
3838
3839 p->inherit_coding_system_flag
3840 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3841
3842 UNGCPRO;
3843 return proc;
3844 }
3845 #endif /* HAVE_SOCKETS */
3846
3847 \f
3848 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3849
3850 #ifdef SIOCGIFCONF
3851 DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
3852 doc: /* Return an alist of all network interfaces and their network address.
3853 Each element is a cons, the car of which is a string containing the
3854 interface name, and the cdr is the network address in internal
3855 format; see the description of ADDRESS in `make-network-process'. */)
3856 ()
3857 {
3858 struct ifconf ifconf;
3859 struct ifreq *ifreqs = NULL;
3860 int ifaces = 0;
3861 int buf_size, s;
3862 Lisp_Object res;
3863
3864 s = socket (AF_INET, SOCK_STREAM, 0);
3865 if (s < 0)
3866 return Qnil;
3867
3868 again:
3869 ifaces += 25;
3870 buf_size = ifaces * sizeof(ifreqs[0]);
3871 ifreqs = (struct ifreq *)xrealloc(ifreqs, buf_size);
3872 if (!ifreqs)
3873 {
3874 close (s);
3875 return Qnil;
3876 }
3877
3878 ifconf.ifc_len = buf_size;
3879 ifconf.ifc_req = ifreqs;
3880 if (ioctl (s, SIOCGIFCONF, &ifconf))
3881 {
3882 close (s);
3883 return Qnil;
3884 }
3885
3886 if (ifconf.ifc_len == buf_size)
3887 goto again;
3888
3889 close (s);
3890 ifaces = ifconf.ifc_len / sizeof (ifreqs[0]);
3891
3892 res = Qnil;
3893 while (--ifaces >= 0)
3894 {
3895 struct ifreq *ifq = &ifreqs[ifaces];
3896 char namebuf[sizeof (ifq->ifr_name) + 1];
3897 if (ifq->ifr_addr.sa_family != AF_INET)
3898 continue;
3899 bcopy (ifq->ifr_name, namebuf, sizeof (ifq->ifr_name));
3900 namebuf[sizeof (ifq->ifr_name)] = 0;
3901 res = Fcons (Fcons (build_string (namebuf),
3902 conv_sockaddr_to_lisp (&ifq->ifr_addr,
3903 sizeof (struct sockaddr))),
3904 res);
3905 }
3906
3907 return res;
3908 }
3909 #endif /* SIOCGIFCONF */
3910
3911 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3912
3913 struct ifflag_def {
3914 int flag_bit;
3915 char *flag_sym;
3916 };
3917
3918 static struct ifflag_def ifflag_table[] = {
3919 #ifdef IFF_UP
3920 { IFF_UP, "up" },
3921 #endif
3922 #ifdef IFF_BROADCAST
3923 { IFF_BROADCAST, "broadcast" },
3924 #endif
3925 #ifdef IFF_DEBUG
3926 { IFF_DEBUG, "debug" },
3927 #endif
3928 #ifdef IFF_LOOPBACK
3929 { IFF_LOOPBACK, "loopback" },
3930 #endif
3931 #ifdef IFF_POINTOPOINT
3932 { IFF_POINTOPOINT, "pointopoint" },
3933 #endif
3934 #ifdef IFF_RUNNING
3935 { IFF_RUNNING, "running" },
3936 #endif
3937 #ifdef IFF_NOARP
3938 { IFF_NOARP, "noarp" },
3939 #endif
3940 #ifdef IFF_PROMISC
3941 { IFF_PROMISC, "promisc" },
3942 #endif
3943 #ifdef IFF_NOTRAILERS
3944 { IFF_NOTRAILERS, "notrailers" },
3945 #endif
3946 #ifdef IFF_ALLMULTI
3947 { IFF_ALLMULTI, "allmulti" },
3948 #endif
3949 #ifdef IFF_MASTER
3950 { IFF_MASTER, "master" },
3951 #endif
3952 #ifdef IFF_SLAVE
3953 { IFF_SLAVE, "slave" },
3954 #endif
3955 #ifdef IFF_MULTICAST
3956 { IFF_MULTICAST, "multicast" },
3957 #endif
3958 #ifdef IFF_PORTSEL
3959 { IFF_PORTSEL, "portsel" },
3960 #endif
3961 #ifdef IFF_AUTOMEDIA
3962 { IFF_AUTOMEDIA, "automedia" },
3963 #endif
3964 #ifdef IFF_DYNAMIC
3965 { IFF_DYNAMIC, "dynamic" },
3966 #endif
3967 #ifdef IFF_OACTIVE
3968 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress */
3969 #endif
3970 #ifdef IFF_SIMPLEX
3971 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions */
3972 #endif
3973 #ifdef IFF_LINK0
3974 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit */
3975 #endif
3976 #ifdef IFF_LINK1
3977 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit */
3978 #endif
3979 #ifdef IFF_LINK2
3980 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit */
3981 #endif
3982 { 0, 0 }
3983 };
3984
3985 DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
3986 doc: /* Return information about network interface named IFNAME.
3987 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3988 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3989 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3990 FLAGS is the current flags of the interface. */)
3991 (ifname)
3992 Lisp_Object ifname;
3993 {
3994 struct ifreq rq;
3995 Lisp_Object res = Qnil;
3996 Lisp_Object elt;
3997 int s;
3998 int any = 0;
3999
4000 CHECK_STRING (ifname);
4001
4002 bzero (rq.ifr_name, sizeof rq.ifr_name);
4003 strncpy (rq.ifr_name, SDATA (ifname), sizeof (rq.ifr_name));
4004
4005 s = socket (AF_INET, SOCK_STREAM, 0);
4006 if (s < 0)
4007 return Qnil;
4008
4009 elt = Qnil;
4010 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
4011 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4012 {
4013 int flags = rq.ifr_flags;
4014 struct ifflag_def *fp;
4015 int fnum;
4016
4017 any++;
4018 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4019 {
4020 if (flags & fp->flag_bit)
4021 {
4022 elt = Fcons (intern (fp->flag_sym), elt);
4023 flags -= fp->flag_bit;
4024 }
4025 }
4026 for (fnum = 0; flags && fnum < 32; fnum++)
4027 {
4028 if (flags & (1 << fnum))
4029 {
4030 elt = Fcons (make_number (fnum), elt);
4031 }
4032 }
4033 }
4034 #endif
4035 res = Fcons (elt, res);
4036
4037 elt = Qnil;
4038 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
4039 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4040 {
4041 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4042 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4043 int n;
4044
4045 any++;
4046 for (n = 0; n < 6; n++)
4047 p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
4048 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4049 }
4050 #endif
4051 res = Fcons (elt, res);
4052
4053 elt = Qnil;
4054 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
4055 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4056 {
4057 any++;
4058 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4059 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4060 #else
4061 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4062 #endif
4063 }
4064 #endif
4065 res = Fcons (elt, res);
4066
4067 elt = Qnil;
4068 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4069 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4070 {
4071 any++;
4072 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4073 }
4074 #endif
4075 res = Fcons (elt, res);
4076
4077 elt = Qnil;
4078 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
4079 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4080 {
4081 any++;
4082 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4083 }
4084 #endif
4085 res = Fcons (elt, res);
4086
4087 close (s);
4088
4089 return any ? res : Qnil;
4090 }
4091 #endif
4092 #endif /* HAVE_SOCKETS */
4093
4094 /* Turn off input and output for process PROC. */
4095
4096 void
4097 deactivate_process (proc)
4098 Lisp_Object proc;
4099 {
4100 register int inchannel, outchannel;
4101 register struct Lisp_Process *p = XPROCESS (proc);
4102
4103 inchannel = p->infd;
4104 outchannel = p->outfd;
4105
4106 #ifdef ADAPTIVE_READ_BUFFERING
4107 if (p->read_output_delay > 0)
4108 {
4109 if (--process_output_delay_count < 0)
4110 process_output_delay_count = 0;
4111 p->read_output_delay = 0;
4112 p->read_output_skip = 0;
4113 }
4114 #endif
4115
4116 if (inchannel >= 0)
4117 {
4118 /* Beware SIGCHLD hereabouts. */
4119 flush_pending_output (inchannel);
4120 #ifdef VMS
4121 {
4122 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
4123 sys$dassgn (outchannel);
4124 vs = get_vms_process_pointer (p->pid);
4125 if (vs)
4126 give_back_vms_process_stuff (vs);
4127 }
4128 #else
4129 emacs_close (inchannel);
4130 if (outchannel >= 0 && outchannel != inchannel)
4131 emacs_close (outchannel);
4132 #endif
4133
4134 p->infd = -1;
4135 p->outfd = -1;
4136 #ifdef DATAGRAM_SOCKETS
4137 if (DATAGRAM_CHAN_P (inchannel))
4138 {
4139 xfree (datagram_address[inchannel].sa);
4140 datagram_address[inchannel].sa = 0;
4141 datagram_address[inchannel].len = 0;
4142 }
4143 #endif
4144 chan_process[inchannel] = Qnil;
4145 FD_CLR (inchannel, &input_wait_mask);
4146 FD_CLR (inchannel, &non_keyboard_wait_mask);
4147 #ifdef NON_BLOCKING_CONNECT
4148 if (FD_ISSET (inchannel, &connect_wait_mask))
4149 {
4150 FD_CLR (inchannel, &connect_wait_mask);
4151 if (--num_pending_connects < 0)
4152 abort ();
4153 }
4154 #endif
4155 if (inchannel == max_process_desc)
4156 {
4157 int i;
4158 /* We just closed the highest-numbered process input descriptor,
4159 so recompute the highest-numbered one now. */
4160 max_process_desc = 0;
4161 for (i = 0; i < MAXDESC; i++)
4162 if (!NILP (chan_process[i]))
4163 max_process_desc = i;
4164 }
4165 }
4166 }
4167
4168 /* Close all descriptors currently in use for communication
4169 with subprocess. This is used in a newly-forked subprocess
4170 to get rid of irrelevant descriptors. */
4171
4172 void
4173 close_process_descs ()
4174 {
4175 #ifndef WINDOWSNT
4176 int i;
4177 for (i = 0; i < MAXDESC; i++)
4178 {
4179 Lisp_Object process;
4180 process = chan_process[i];
4181 if (!NILP (process))
4182 {
4183 int in = XPROCESS (process)->infd;
4184 int out = XPROCESS (process)->outfd;
4185 if (in >= 0)
4186 emacs_close (in);
4187 if (out >= 0 && in != out)
4188 emacs_close (out);
4189 }
4190 }
4191 #endif
4192 }
4193 \f
4194 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4195 0, 4, 0,
4196 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4197 It is read into the process' buffers or given to their filter functions.
4198 Non-nil arg PROCESS means do not return until some output has been received
4199 from PROCESS.
4200
4201 Non-nil second arg SECONDS and third arg MILLISEC are number of
4202 seconds and milliseconds to wait; return after that much time whether
4203 or not there is input. If SECONDS is a floating point number,
4204 it specifies a fractional number of seconds to wait.
4205 The MILLISEC argument is obsolete and should be avoided.
4206
4207 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
4208 from PROCESS, suspending reading output from other processes.
4209 If JUST-THIS-ONE is an integer, don't run any timers either.
4210 Return non-nil if we received any output before the timeout expired. */)
4211 (process, seconds, millisec, just_this_one)
4212 register Lisp_Object process, seconds, millisec, just_this_one;
4213 {
4214 int secs, usecs = 0;
4215
4216 if (! NILP (process))
4217 CHECK_PROCESS (process);
4218 else
4219 just_this_one = Qnil;
4220
4221 if (!NILP (millisec))
4222 { /* Obsolete calling convention using integers rather than floats. */
4223 CHECK_NUMBER (millisec);
4224 if (NILP (seconds))
4225 seconds = make_float (XINT (millisec) / 1000.0);
4226 else
4227 {
4228 CHECK_NUMBER (seconds);
4229 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4230 }
4231 }
4232
4233 if (!NILP (seconds))
4234 {
4235 if (INTEGERP (seconds))
4236 secs = XINT (seconds);
4237 else if (FLOATP (seconds))
4238 {
4239 double timeout = XFLOAT_DATA (seconds);
4240 secs = (int) timeout;
4241 usecs = (int) ((timeout - (double) secs) * 1000000);
4242 }
4243 else
4244 wrong_type_argument (Qnumberp, seconds);
4245
4246 if (secs < 0 || (secs == 0 && usecs == 0))
4247 secs = -1, usecs = 0;
4248 }
4249 else
4250 secs = NILP (process) ? -1 : 0;
4251
4252 return
4253 (wait_reading_process_output (secs, usecs, 0, 0,
4254 Qnil,
4255 !NILP (process) ? XPROCESS (process) : NULL,
4256 NILP (just_this_one) ? 0 :
4257 !INTEGERP (just_this_one) ? 1 : -1)
4258 ? Qt : Qnil);
4259 }
4260
4261 /* Accept a connection for server process SERVER on CHANNEL. */
4262
4263 static int connect_counter = 0;
4264
4265 static void
4266 server_accept_connection (server, channel)
4267 Lisp_Object server;
4268 int channel;
4269 {
4270 Lisp_Object proc, caller, name, buffer;
4271 Lisp_Object contact, host, service;
4272 struct Lisp_Process *ps= XPROCESS (server);
4273 struct Lisp_Process *p;
4274 int s;
4275 union u_sockaddr {
4276 struct sockaddr sa;
4277 struct sockaddr_in in;
4278 #ifdef AF_INET6
4279 struct sockaddr_in6 in6;
4280 #endif
4281 #ifdef HAVE_LOCAL_SOCKETS
4282 struct sockaddr_un un;
4283 #endif
4284 } saddr;
4285 int len = sizeof saddr;
4286
4287 s = accept (channel, &saddr.sa, &len);
4288
4289 if (s < 0)
4290 {
4291 int code = errno;
4292
4293 if (code == EAGAIN)
4294 return;
4295 #ifdef EWOULDBLOCK
4296 if (code == EWOULDBLOCK)
4297 return;
4298 #endif
4299
4300 if (!NILP (ps->log))
4301 call3 (ps->log, server, Qnil,
4302 concat3 (build_string ("accept failed with code"),
4303 Fnumber_to_string (make_number (code)),
4304 build_string ("\n")));
4305 return;
4306 }
4307
4308 connect_counter++;
4309
4310 /* Setup a new process to handle the connection. */
4311
4312 /* Generate a unique identification of the caller, and build contact
4313 information for this process. */
4314 host = Qt;
4315 service = Qnil;
4316 switch (saddr.sa.sa_family)
4317 {
4318 case AF_INET:
4319 {
4320 Lisp_Object args[5];
4321 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4322 args[0] = build_string ("%d.%d.%d.%d");
4323 args[1] = make_number (*ip++);
4324 args[2] = make_number (*ip++);
4325 args[3] = make_number (*ip++);
4326 args[4] = make_number (*ip++);
4327 host = Fformat (5, args);
4328 service = make_number (ntohs (saddr.in.sin_port));
4329
4330 args[0] = build_string (" <%s:%d>");
4331 args[1] = host;
4332 args[2] = service;
4333 caller = Fformat (3, args);
4334 }
4335 break;
4336
4337 #ifdef AF_INET6
4338 case AF_INET6:
4339 {
4340 Lisp_Object args[9];
4341 uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
4342 int i;
4343 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4344 for (i = 0; i < 8; i++)
4345 args[i+1] = make_number (ntohs(ip6[i]));
4346 host = Fformat (9, args);
4347 service = make_number (ntohs (saddr.in.sin_port));
4348
4349 args[0] = build_string (" <[%s]:%d>");
4350 args[1] = host;
4351 args[2] = service;
4352 caller = Fformat (3, args);
4353 }
4354 break;
4355 #endif
4356
4357 #ifdef HAVE_LOCAL_SOCKETS
4358 case AF_LOCAL:
4359 #endif
4360 default:
4361 caller = Fnumber_to_string (make_number (connect_counter));
4362 caller = concat3 (build_string (" <"), caller, build_string (">"));
4363 break;
4364 }
4365
4366 /* Create a new buffer name for this process if it doesn't have a
4367 filter. The new buffer name is based on the buffer name or
4368 process name of the server process concatenated with the caller
4369 identification. */
4370
4371 if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
4372 buffer = Qnil;
4373 else
4374 {
4375 buffer = ps->buffer;
4376 if (!NILP (buffer))
4377 buffer = Fbuffer_name (buffer);
4378 else
4379 buffer = ps->name;
4380 if (!NILP (buffer))
4381 {
4382 buffer = concat2 (buffer, caller);
4383 buffer = Fget_buffer_create (buffer);
4384 }
4385 }
4386
4387 /* Generate a unique name for the new server process. Combine the
4388 server process name with the caller identification. */
4389
4390 name = concat2 (ps->name, caller);
4391 proc = make_process (name);
4392
4393 chan_process[s] = proc;
4394
4395 #ifdef O_NONBLOCK
4396 fcntl (s, F_SETFL, O_NONBLOCK);
4397 #else
4398 #ifdef O_NDELAY
4399 fcntl (s, F_SETFL, O_NDELAY);
4400 #endif
4401 #endif
4402
4403 p = XPROCESS (proc);
4404
4405 /* Build new contact information for this setup. */
4406 contact = Fcopy_sequence (ps->childp);
4407 contact = Fplist_put (contact, QCserver, Qnil);
4408 contact = Fplist_put (contact, QChost, host);
4409 if (!NILP (service))
4410 contact = Fplist_put (contact, QCservice, service);
4411 contact = Fplist_put (contact, QCremote,
4412 conv_sockaddr_to_lisp (&saddr.sa, len));
4413 #ifdef HAVE_GETSOCKNAME
4414 len = sizeof saddr;
4415 if (getsockname (s, &saddr.sa, &len) == 0)
4416 contact = Fplist_put (contact, QClocal,
4417 conv_sockaddr_to_lisp (&saddr.sa, len));
4418 #endif
4419
4420 p->childp = contact;
4421 p->plist = Fcopy_sequence (ps->plist);
4422 p->type = Qnetwork;
4423
4424 p->buffer = buffer;
4425 p->sentinel = ps->sentinel;
4426 p->filter = ps->filter;
4427 p->command = Qnil;
4428 p->pid = 0;
4429 p->infd = s;
4430 p->outfd = s;
4431 p->status = Qrun;
4432
4433 /* Client processes for accepted connections are not stopped initially. */
4434 if (!EQ (p->filter, Qt))
4435 {
4436 FD_SET (s, &input_wait_mask);
4437 FD_SET (s, &non_keyboard_wait_mask);
4438 }
4439
4440 if (s > max_process_desc)
4441 max_process_desc = s;
4442
4443 /* Setup coding system for new process based on server process.
4444 This seems to be the proper thing to do, as the coding system
4445 of the new process should reflect the settings at the time the
4446 server socket was opened; not the current settings. */
4447
4448 p->decode_coding_system = ps->decode_coding_system;
4449 p->encode_coding_system = ps->encode_coding_system;
4450 setup_process_coding_systems (proc);
4451
4452 p->decoding_buf = make_uninit_string (0);
4453 p->decoding_carryover = 0;
4454 p->encoding_buf = make_uninit_string (0);
4455
4456 p->inherit_coding_system_flag
4457 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4458
4459 if (!NILP (ps->log))
4460 call3 (ps->log, server, proc,
4461 concat3 (build_string ("accept from "),
4462 (STRINGP (host) ? host : build_string ("-")),
4463 build_string ("\n")));
4464
4465 if (!NILP (p->sentinel))
4466 exec_sentinel (proc,
4467 concat3 (build_string ("open from "),
4468 (STRINGP (host) ? host : build_string ("-")),
4469 build_string ("\n")));
4470 }
4471
4472 /* This variable is different from waiting_for_input in keyboard.c.
4473 It is used to communicate to a lisp process-filter/sentinel (via the
4474 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4475 for user-input when that process-filter was called.
4476 waiting_for_input cannot be used as that is by definition 0 when
4477 lisp code is being evalled.
4478 This is also used in record_asynch_buffer_change.
4479 For that purpose, this must be 0
4480 when not inside wait_reading_process_output. */
4481 static int waiting_for_user_input_p;
4482
4483 static Lisp_Object
4484 wait_reading_process_output_unwind (data)
4485 Lisp_Object data;
4486 {
4487 waiting_for_user_input_p = XINT (data);
4488 return Qnil;
4489 }
4490
4491 /* This is here so breakpoints can be put on it. */
4492 static void
4493 wait_reading_process_output_1 ()
4494 {
4495 }
4496
4497 /* Use a wrapper around select to work around a bug in gdb 5.3.
4498 Normally, the wrapper is optimzed away by inlining.
4499
4500 If emacs is stopped inside select, the gdb backtrace doesn't
4501 show the function which called select, so it is practically
4502 impossible to step through wait_reading_process_output. */
4503
4504 #ifndef select
4505 static INLINE int
4506 select_wrapper (n, rfd, wfd, xfd, tmo)
4507 int n;
4508 SELECT_TYPE *rfd, *wfd, *xfd;
4509 EMACS_TIME *tmo;
4510 {
4511 return select (n, rfd, wfd, xfd, tmo);
4512 }
4513 #define select select_wrapper
4514 #endif
4515
4516 /* Read and dispose of subprocess output while waiting for timeout to
4517 elapse and/or keyboard input to be available.
4518
4519 TIME_LIMIT is:
4520 timeout in seconds, or
4521 zero for no limit, or
4522 -1 means gobble data immediately available but don't wait for any.
4523
4524 MICROSECS is:
4525 an additional duration to wait, measured in microseconds.
4526 If this is nonzero and time_limit is 0, then the timeout
4527 consists of MICROSECS only.
4528
4529 READ_KBD is a lisp value:
4530 0 to ignore keyboard input, or
4531 1 to return when input is available, or
4532 -1 meaning caller will actually read the input, so don't throw to
4533 the quit handler, or
4534
4535 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4536 output that arrives.
4537
4538 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4539 (and gobble terminal input into the buffer if any arrives).
4540
4541 If WAIT_PROC is specified, wait until something arrives from that
4542 process. The return value is true if we read some input from
4543 that process.
4544
4545 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4546 (suspending output from other processes). A negative value
4547 means don't run any timers either.
4548
4549 If WAIT_PROC is specified, then the function returns true if we
4550 received input from that process before the timeout elapsed.
4551 Otherwise, return true if we received input from any process. */
4552
4553 int
4554 wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4555 wait_for_cell, wait_proc, just_wait_proc)
4556 int time_limit, microsecs, read_kbd, do_display;
4557 Lisp_Object wait_for_cell;
4558 struct Lisp_Process *wait_proc;
4559 int just_wait_proc;
4560 {
4561 register int channel, nfds;
4562 SELECT_TYPE Available;
4563 #ifdef NON_BLOCKING_CONNECT
4564 SELECT_TYPE Connecting;
4565 int check_connect;
4566 #endif
4567 int check_delay, no_avail;
4568 int xerrno;
4569 Lisp_Object proc;
4570 EMACS_TIME timeout, end_time;
4571 int wait_channel = -1;
4572 int got_some_input = 0;
4573 int count = SPECPDL_INDEX ();
4574
4575 FD_ZERO (&Available);
4576 #ifdef NON_BLOCKING_CONNECT
4577 FD_ZERO (&Connecting);
4578 #endif
4579
4580 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4581 if (wait_proc != NULL)
4582 wait_channel = wait_proc->infd;
4583
4584 record_unwind_protect (wait_reading_process_output_unwind,
4585 make_number (waiting_for_user_input_p));
4586 waiting_for_user_input_p = read_kbd;
4587
4588 /* Since we may need to wait several times,
4589 compute the absolute time to return at. */
4590 if (time_limit || microsecs)
4591 {
4592 EMACS_GET_TIME (end_time);
4593 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
4594 EMACS_ADD_TIME (end_time, end_time, timeout);
4595 }
4596
4597 while (1)
4598 {
4599 int timeout_reduced_for_timers = 0;
4600
4601 /* If calling from keyboard input, do not quit
4602 since we want to return C-g as an input character.
4603 Otherwise, do pending quit if requested. */
4604 if (read_kbd >= 0)
4605 QUIT;
4606 #ifdef SYNC_INPUT
4607 else
4608 {
4609 if (interrupt_input_pending)
4610 handle_async_input ();
4611 if (pending_atimers)
4612 do_pending_atimers ();
4613 }
4614 #endif
4615
4616 /* Exit now if the cell we're waiting for became non-nil. */
4617 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4618 break;
4619
4620 /* Compute time from now till when time limit is up */
4621 /* Exit if already run out */
4622 if (time_limit == -1)
4623 {
4624 /* -1 specified for timeout means
4625 gobble output available now
4626 but don't wait at all. */
4627
4628 EMACS_SET_SECS_USECS (timeout, 0, 0);
4629 }
4630 else if (time_limit || microsecs)
4631 {
4632 EMACS_GET_TIME (timeout);
4633 EMACS_SUB_TIME (timeout, end_time, timeout);
4634 if (EMACS_TIME_NEG_P (timeout))
4635 break;
4636 }
4637 else
4638 {
4639 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4640 }
4641
4642 /* Normally we run timers here.
4643 But not if wait_for_cell; in those cases,
4644 the wait is supposed to be short,
4645 and those callers cannot handle running arbitrary Lisp code here. */
4646 if (NILP (wait_for_cell)
4647 && just_wait_proc >= 0)
4648 {
4649 EMACS_TIME timer_delay;
4650
4651 do
4652 {
4653 int old_timers_run = timers_run;
4654 struct buffer *old_buffer = current_buffer;
4655 Lisp_Object old_window = selected_window;
4656
4657 timer_delay = timer_check (1);
4658
4659 /* If a timer has run, this might have changed buffers
4660 an alike. Make read_key_sequence aware of that. */
4661 if (timers_run != old_timers_run
4662 && (old_buffer != current_buffer
4663 || !EQ (old_window, selected_window))
4664 && waiting_for_user_input_p == -1)
4665 record_asynch_buffer_change ();
4666
4667 if (timers_run != old_timers_run && do_display)
4668 /* We must retry, since a timer may have requeued itself
4669 and that could alter the time_delay. */
4670 redisplay_preserve_echo_area (9);
4671 else
4672 break;
4673 }
4674 while (!detect_input_pending ());
4675
4676 /* If there is unread keyboard input, also return. */
4677 if (read_kbd != 0
4678 && requeued_events_pending_p ())
4679 break;
4680
4681 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
4682 {
4683 EMACS_TIME difference;
4684 EMACS_SUB_TIME (difference, timer_delay, timeout);
4685 if (EMACS_TIME_NEG_P (difference))
4686 {
4687 timeout = timer_delay;
4688 timeout_reduced_for_timers = 1;
4689 }
4690 }
4691 /* If time_limit is -1, we are not going to wait at all. */
4692 else if (time_limit != -1)
4693 {
4694 /* This is so a breakpoint can be put here. */
4695 wait_reading_process_output_1 ();
4696 }
4697 }
4698
4699 /* Cause C-g and alarm signals to take immediate action,
4700 and cause input available signals to zero out timeout.
4701
4702 It is important that we do this before checking for process
4703 activity. If we get a SIGCHLD after the explicit checks for
4704 process activity, timeout is the only way we will know. */
4705 if (read_kbd < 0)
4706 set_waiting_for_input (&timeout);
4707
4708 /* If status of something has changed, and no input is
4709 available, notify the user of the change right away. After
4710 this explicit check, we'll let the SIGCHLD handler zap
4711 timeout to get our attention. When Emacs is run
4712 interactively, only do this with a nonzero DO_DISPLAY
4713 argument, because status_notify triggers redisplay. */
4714 if (update_tick != process_tick
4715 && (do_display || noninteractive))
4716 {
4717 SELECT_TYPE Atemp;
4718 #ifdef NON_BLOCKING_CONNECT
4719 SELECT_TYPE Ctemp;
4720 #endif
4721
4722 Atemp = input_wait_mask;
4723 #if 0
4724 /* On Mac OS X 10.0, the SELECT system call always says input is
4725 present (for reading) at stdin, even when none is. This
4726 causes the call to SELECT below to return 1 and
4727 status_notify not to be called. As a result output of
4728 subprocesses are incorrectly discarded.
4729 */
4730 FD_CLR (0, &Atemp);
4731 #endif
4732 IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
4733
4734 EMACS_SET_SECS_USECS (timeout, 0, 0);
4735 if ((select (max (max (max_process_desc, max_keyboard_desc),
4736 max_gpm_desc) + 1,
4737 &Atemp,
4738 #ifdef NON_BLOCKING_CONNECT
4739 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
4740 #else
4741 (SELECT_TYPE *)0,
4742 #endif
4743 (SELECT_TYPE *)0, &timeout)
4744 <= 0))
4745 {
4746 /* It's okay for us to do this and then continue with
4747 the loop, since timeout has already been zeroed out. */
4748 clear_waiting_for_input ();
4749 status_notify (NULL);
4750 }
4751 }
4752
4753 /* Don't wait for output from a non-running process. Just
4754 read whatever data has already been received. */
4755 if (wait_proc && wait_proc->raw_status_new)
4756 update_status (wait_proc);
4757 if (wait_proc
4758 && ! EQ (wait_proc->status, Qrun)
4759 && ! EQ (wait_proc->status, Qconnect))
4760 {
4761 int nread, total_nread = 0;
4762
4763 clear_waiting_for_input ();
4764 XSETPROCESS (proc, wait_proc);
4765
4766 /* Read data from the process, until we exhaust it. */
4767 while (wait_proc->infd >= 0)
4768 {
4769 nread = read_process_output (proc, wait_proc->infd);
4770
4771 if (nread == 0)
4772 break;
4773
4774 if (0 < nread)
4775 {
4776 total_nread += nread;
4777 got_some_input = 1;
4778 }
4779 #ifdef EIO
4780 else if (nread == -1 && EIO == errno)
4781 break;
4782 #endif
4783 #ifdef EAGAIN
4784 else if (nread == -1 && EAGAIN == errno)
4785 break;
4786 #endif
4787 #ifdef EWOULDBLOCK
4788 else if (nread == -1 && EWOULDBLOCK == errno)
4789 break;
4790 #endif
4791 }
4792 if (total_nread > 0 && do_display)
4793 redisplay_preserve_echo_area (10);
4794
4795 break;
4796 }
4797
4798 /* Wait till there is something to do */
4799
4800 if (wait_proc && just_wait_proc)
4801 {
4802 if (wait_proc->infd < 0) /* Terminated */
4803 break;
4804 FD_SET (wait_proc->infd, &Available);
4805 check_delay = 0;
4806 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4807 }
4808 else if (!NILP (wait_for_cell))
4809 {
4810 Available = non_process_wait_mask;
4811 check_delay = 0;
4812 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4813 }
4814 else
4815 {
4816 if (! read_kbd)
4817 Available = non_keyboard_wait_mask;
4818 else
4819 Available = input_wait_mask;
4820 IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0));
4821 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
4822 }
4823
4824 /* If frame size has changed or the window is newly mapped,
4825 redisplay now, before we start to wait. There is a race
4826 condition here; if a SIGIO arrives between now and the select
4827 and indicates that a frame is trashed, the select may block
4828 displaying a trashed screen. */
4829 if (frame_garbaged && do_display)
4830 {
4831 clear_waiting_for_input ();
4832 redisplay_preserve_echo_area (11);
4833 if (read_kbd < 0)
4834 set_waiting_for_input (&timeout);
4835 }
4836
4837 no_avail = 0;
4838 if (read_kbd && detect_input_pending ())
4839 {
4840 nfds = 0;
4841 no_avail = 1;
4842 }
4843 else
4844 {
4845 #ifdef NON_BLOCKING_CONNECT
4846 if (check_connect)
4847 Connecting = connect_wait_mask;
4848 #endif
4849
4850 #ifdef ADAPTIVE_READ_BUFFERING
4851 /* Set the timeout for adaptive read buffering if any
4852 process has non-zero read_output_skip and non-zero
4853 read_output_delay, and we are not reading output for a
4854 specific wait_channel. It is not executed if
4855 Vprocess_adaptive_read_buffering is nil. */
4856 if (process_output_skip && check_delay > 0)
4857 {
4858 int usecs = EMACS_USECS (timeout);
4859 if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
4860 usecs = READ_OUTPUT_DELAY_MAX;
4861 for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
4862 {
4863 proc = chan_process[channel];
4864 if (NILP (proc))
4865 continue;
4866 /* Find minimum non-zero read_output_delay among the
4867 processes with non-zero read_output_skip. */
4868 if (XPROCESS (proc)->read_output_delay > 0)
4869 {
4870 check_delay--;
4871 if (!XPROCESS (proc)->read_output_skip)
4872 continue;
4873 FD_CLR (channel, &Available);
4874 XPROCESS (proc)->read_output_skip = 0;
4875 if (XPROCESS (proc)->read_output_delay < usecs)
4876 usecs = XPROCESS (proc)->read_output_delay;
4877 }
4878 }
4879 EMACS_SET_SECS_USECS (timeout, 0, usecs);
4880 process_output_skip = 0;
4881 }
4882 #endif
4883
4884 nfds = select (max (max (max_process_desc, max_keyboard_desc),
4885 max_gpm_desc) + 1,
4886 &Available,
4887 #ifdef NON_BLOCKING_CONNECT
4888 (check_connect ? &Connecting : (SELECT_TYPE *)0),
4889 #else
4890 (SELECT_TYPE *)0,
4891 #endif
4892 (SELECT_TYPE *)0, &timeout);
4893 }
4894
4895 xerrno = errno;
4896
4897 /* Make C-g and alarm signals set flags again */
4898 clear_waiting_for_input ();
4899
4900 /* If we woke up due to SIGWINCH, actually change size now. */
4901 do_pending_window_change (0);
4902
4903 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4904 /* We wanted the full specified time, so return now. */
4905 break;
4906 if (nfds < 0)
4907 {
4908 if (xerrno == EINTR)
4909 no_avail = 1;
4910 else if (xerrno == EBADF)
4911 {
4912 #ifdef AIX
4913 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4914 the child's closure of the pts gives the parent a SIGHUP, and
4915 the ptc file descriptor is automatically closed,
4916 yielding EBADF here or at select() call above.
4917 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4918 in m/ibmrt-aix.h), and here we just ignore the select error.
4919 Cleanup occurs c/o status_notify after SIGCLD. */
4920 no_avail = 1; /* Cannot depend on values returned */
4921 #else
4922 abort ();
4923 #endif
4924 }
4925 else
4926 error ("select error: %s", emacs_strerror (xerrno));
4927 }
4928
4929 if (no_avail)
4930 {
4931 FD_ZERO (&Available);
4932 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4933 }
4934
4935 #if defined(sun) && !defined(USG5_4)
4936 if (nfds > 0 && keyboard_bit_set (&Available)
4937 && interrupt_input)
4938 /* System sometimes fails to deliver SIGIO.
4939
4940 David J. Mackenzie says that Emacs doesn't compile under
4941 Solaris if this code is enabled, thus the USG5_4 in the CPP
4942 conditional. "I haven't noticed any ill effects so far.
4943 If you find a Solaris expert somewhere, they might know
4944 better." */
4945 kill (getpid (), SIGIO);
4946 #endif
4947
4948 #if 0 /* When polling is used, interrupt_input is 0,
4949 so get_input_pending should read the input.
4950 So this should not be needed. */
4951 /* If we are using polling for input,
4952 and we see input available, make it get read now.
4953 Otherwise it might not actually get read for a second.
4954 And on hpux, since we turn off polling in wait_reading_process_output,
4955 it might never get read at all if we don't spend much time
4956 outside of wait_reading_process_output. */
4957 if (read_kbd && interrupt_input
4958 && keyboard_bit_set (&Available)
4959 && input_polling_used ())
4960 kill (getpid (), SIGALRM);
4961 #endif
4962
4963 /* Check for keyboard input */
4964 /* If there is any, return immediately
4965 to give it higher priority than subprocesses */
4966
4967 if (read_kbd != 0)
4968 {
4969 int old_timers_run = timers_run;
4970 struct buffer *old_buffer = current_buffer;
4971 Lisp_Object old_window = selected_window;
4972 int leave = 0;
4973
4974 if (detect_input_pending_run_timers (do_display))
4975 {
4976 swallow_events (do_display);
4977 if (detect_input_pending_run_timers (do_display))
4978 leave = 1;
4979 }
4980
4981 /* If a timer has run, this might have changed buffers
4982 an alike. Make read_key_sequence aware of that. */
4983 if (timers_run != old_timers_run
4984 && waiting_for_user_input_p == -1
4985 && (old_buffer != current_buffer
4986 || !EQ (old_window, selected_window)))
4987 record_asynch_buffer_change ();
4988
4989 if (leave)
4990 break;
4991 }
4992
4993 /* If there is unread keyboard input, also return. */
4994 if (read_kbd != 0
4995 && requeued_events_pending_p ())
4996 break;
4997
4998 /* If we are not checking for keyboard input now,
4999 do process events (but don't run any timers).
5000 This is so that X events will be processed.
5001 Otherwise they may have to wait until polling takes place.
5002 That would causes delays in pasting selections, for example.
5003
5004 (We used to do this only if wait_for_cell.) */
5005 if (read_kbd == 0 && detect_input_pending ())
5006 {
5007 swallow_events (do_display);
5008 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5009 if (detect_input_pending ())
5010 break;
5011 #endif
5012 }
5013
5014 /* Exit now if the cell we're waiting for became non-nil. */
5015 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5016 break;
5017
5018 #ifdef SIGIO
5019 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5020 go read it. This can happen with X on BSD after logging out.
5021 In that case, there really is no input and no SIGIO,
5022 but select says there is input. */
5023
5024 if (read_kbd && interrupt_input
5025 && keyboard_bit_set (&Available) && ! noninteractive)
5026 kill (getpid (), SIGIO);
5027 #endif
5028
5029 if (! wait_proc)
5030 got_some_input |= nfds > 0;
5031
5032 /* If checking input just got us a size-change event from X,
5033 obey it now if we should. */
5034 if (read_kbd || ! NILP (wait_for_cell))
5035 do_pending_window_change (0);
5036
5037 /* Check for data from a process. */
5038 if (no_avail || nfds == 0)
5039 continue;
5040
5041 /* Really FIRST_PROC_DESC should be 0 on Unix,
5042 but this is safer in the short run. */
5043 for (channel = 0; channel <= max_process_desc; channel++)
5044 {
5045 if (FD_ISSET (channel, &Available)
5046 && FD_ISSET (channel, &non_keyboard_wait_mask))
5047 {
5048 int nread;
5049
5050 /* If waiting for this channel, arrange to return as
5051 soon as no more input to be processed. No more
5052 waiting. */
5053 if (wait_channel == channel)
5054 {
5055 wait_channel = -1;
5056 time_limit = -1;
5057 got_some_input = 1;
5058 }
5059 proc = chan_process[channel];
5060 if (NILP (proc))
5061 continue;
5062
5063 /* If this is a server stream socket, accept connection. */
5064 if (EQ (XPROCESS (proc)->status, Qlisten))
5065 {
5066 server_accept_connection (proc, channel);
5067 continue;
5068 }
5069
5070 /* Read data from the process, starting with our
5071 buffered-ahead character if we have one. */
5072
5073 nread = read_process_output (proc, channel);
5074 if (nread > 0)
5075 {
5076 /* Since read_process_output can run a filter,
5077 which can call accept-process-output,
5078 don't try to read from any other processes
5079 before doing the select again. */
5080 FD_ZERO (&Available);
5081
5082 if (do_display)
5083 redisplay_preserve_echo_area (12);
5084 }
5085 #ifdef EWOULDBLOCK
5086 else if (nread == -1 && errno == EWOULDBLOCK)
5087 ;
5088 #endif
5089 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
5090 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
5091 #ifdef O_NONBLOCK
5092 else if (nread == -1 && errno == EAGAIN)
5093 ;
5094 #else
5095 #ifdef O_NDELAY
5096 else if (nread == -1 && errno == EAGAIN)
5097 ;
5098 /* Note that we cannot distinguish between no input
5099 available now and a closed pipe.
5100 With luck, a closed pipe will be accompanied by
5101 subprocess termination and SIGCHLD. */
5102 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
5103 ;
5104 #endif /* O_NDELAY */
5105 #endif /* O_NONBLOCK */
5106 #ifdef HAVE_PTYS
5107 /* On some OSs with ptys, when the process on one end of
5108 a pty exits, the other end gets an error reading with
5109 errno = EIO instead of getting an EOF (0 bytes read).
5110 Therefore, if we get an error reading and errno =
5111 EIO, just continue, because the child process has
5112 exited and should clean itself up soon (e.g. when we
5113 get a SIGCHLD).
5114
5115 However, it has been known to happen that the SIGCHLD
5116 got lost. So raise the signal again just in case.
5117 It can't hurt. */
5118 else if (nread == -1 && errno == EIO)
5119 {
5120 /* Clear the descriptor now, so we only raise the signal once. */
5121 FD_CLR (channel, &input_wait_mask);
5122 FD_CLR (channel, &non_keyboard_wait_mask);
5123
5124 kill (getpid (), SIGCHLD);
5125 }
5126 #endif /* HAVE_PTYS */
5127 /* If we can detect process termination, don't consider the process
5128 gone just because its pipe is closed. */
5129 #ifdef SIGCHLD
5130 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
5131 ;
5132 #endif
5133 else
5134 {
5135 /* Preserve status of processes already terminated. */
5136 XPROCESS (proc)->tick = ++process_tick;
5137 deactivate_process (proc);
5138 if (XPROCESS (proc)->raw_status_new)
5139 update_status (XPROCESS (proc));
5140 if (EQ (XPROCESS (proc)->status, Qrun))
5141 XPROCESS (proc)->status
5142 = Fcons (Qexit, Fcons (make_number (256), Qnil));
5143 }
5144 }
5145 #ifdef NON_BLOCKING_CONNECT
5146 if (check_connect && FD_ISSET (channel, &Connecting)
5147 && FD_ISSET (channel, &connect_wait_mask))
5148 {
5149 struct Lisp_Process *p;
5150
5151 FD_CLR (channel, &connect_wait_mask);
5152 if (--num_pending_connects < 0)
5153 abort ();
5154
5155 proc = chan_process[channel];
5156 if (NILP (proc))
5157 continue;
5158
5159 p = XPROCESS (proc);
5160
5161 #ifdef GNU_LINUX
5162 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5163 So only use it on systems where it is known to work. */
5164 {
5165 int xlen = sizeof(xerrno);
5166 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5167 xerrno = errno;
5168 }
5169 #else
5170 {
5171 struct sockaddr pname;
5172 int pnamelen = sizeof(pname);
5173
5174 /* If connection failed, getpeername will fail. */
5175 xerrno = 0;
5176 if (getpeername(channel, &pname, &pnamelen) < 0)
5177 {
5178 /* Obtain connect failure code through error slippage. */
5179 char dummy;
5180 xerrno = errno;
5181 if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
5182 xerrno = errno;
5183 }
5184 }
5185 #endif
5186 if (xerrno)
5187 {
5188 p->tick = ++process_tick;
5189 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
5190 deactivate_process (proc);
5191 }
5192 else
5193 {
5194 p->status = Qrun;
5195 /* Execute the sentinel here. If we had relied on
5196 status_notify to do it later, it will read input
5197 from the process before calling the sentinel. */
5198 exec_sentinel (proc, build_string ("open\n"));
5199 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
5200 {
5201 FD_SET (p->infd, &input_wait_mask);
5202 FD_SET (p->infd, &non_keyboard_wait_mask);
5203 }
5204 }
5205 }
5206 #endif /* NON_BLOCKING_CONNECT */
5207 } /* end for each file descriptor */
5208 } /* end while exit conditions not met */
5209
5210 unbind_to (count, Qnil);
5211
5212 /* If calling from keyboard input, do not quit
5213 since we want to return C-g as an input character.
5214 Otherwise, do pending quit if requested. */
5215 if (read_kbd >= 0)
5216 {
5217 /* Prevent input_pending from remaining set if we quit. */
5218 clear_input_pending ();
5219 QUIT;
5220 }
5221
5222 return got_some_input;
5223 }
5224 \f
5225 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5226
5227 static Lisp_Object
5228 read_process_output_call (fun_and_args)
5229 Lisp_Object fun_and_args;
5230 {
5231 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5232 }
5233
5234 static Lisp_Object
5235 read_process_output_error_handler (error)
5236 Lisp_Object error;
5237 {
5238 cmd_error_internal (error, "error in process filter: ");
5239 Vinhibit_quit = Qt;
5240 update_echo_area ();
5241 Fsleep_for (make_number (2), Qnil);
5242 return Qt;
5243 }
5244
5245 /* Read pending output from the process channel,
5246 starting with our buffered-ahead character if we have one.
5247 Yield number of decoded characters read.
5248
5249 This function reads at most 4096 characters.
5250 If you want to read all available subprocess output,
5251 you must call it repeatedly until it returns zero.
5252
5253 The characters read are decoded according to PROC's coding-system
5254 for decoding. */
5255
5256 static int
5257 read_process_output (proc, channel)
5258 Lisp_Object proc;
5259 register int channel;
5260 {
5261 register int nbytes;
5262 char *chars;
5263 register Lisp_Object outstream;
5264 register struct buffer *old = current_buffer;
5265 register struct Lisp_Process *p = XPROCESS (proc);
5266 register int opoint;
5267 struct coding_system *coding = proc_decode_coding_system[channel];
5268 int carryover = p->decoding_carryover;
5269 int readmax = 4096;
5270
5271 #ifdef VMS
5272 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
5273
5274 vs = get_vms_process_pointer (p->pid);
5275 if (vs)
5276 {
5277 if (!vs->iosb[0])
5278 return (0); /* Really weird if it does this */
5279 if (!(vs->iosb[0] & 1))
5280 return -1; /* I/O error */
5281 }
5282 else
5283 error ("Could not get VMS process pointer");
5284 chars = vs->inputBuffer;
5285 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
5286 if (nbytes <= 0)
5287 {
5288 start_vms_process_read (vs); /* Crank up the next read on the process */
5289 return 1; /* Nothing worth printing, say we got 1 */
5290 }
5291 if (carryover > 0)
5292 {
5293 /* The data carried over in the previous decoding (which are at
5294 the tail of decoding buffer) should be prepended to the new
5295 data read to decode all together. */
5296 chars = (char *) alloca (nbytes + carryover);
5297 bcopy (SDATA (p->decoding_buf), buf, carryover);
5298 bcopy (vs->inputBuffer, chars + carryover, nbytes);
5299 }
5300 #else /* not VMS */
5301
5302 chars = (char *) alloca (carryover + readmax);
5303 if (carryover)
5304 /* See the comment above. */
5305 bcopy (SDATA (p->decoding_buf), chars, carryover);
5306
5307 #ifdef DATAGRAM_SOCKETS
5308 /* We have a working select, so proc_buffered_char is always -1. */
5309 if (DATAGRAM_CHAN_P (channel))
5310 {
5311 int len = datagram_address[channel].len;
5312 nbytes = recvfrom (channel, chars + carryover, readmax,
5313 0, datagram_address[channel].sa, &len);
5314 }
5315 else
5316 #endif
5317 if (proc_buffered_char[channel] < 0)
5318 {
5319 nbytes = emacs_read (channel, chars + carryover, readmax);
5320 #ifdef ADAPTIVE_READ_BUFFERING
5321 if (nbytes > 0 && p->adaptive_read_buffering)
5322 {
5323 int delay = p->read_output_delay;
5324 if (nbytes < 256)
5325 {
5326 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5327 {
5328 if (delay == 0)
5329 process_output_delay_count++;
5330 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5331 }
5332 }
5333 else if (delay > 0 && (nbytes == readmax))
5334 {
5335 delay -= READ_OUTPUT_DELAY_INCREMENT;
5336 if (delay == 0)
5337 process_output_delay_count--;
5338 }
5339 p->read_output_delay = delay;
5340 if (delay)
5341 {
5342 p->read_output_skip = 1;
5343 process_output_skip = 1;
5344 }
5345 }
5346 #endif
5347 }
5348 else
5349 {
5350 chars[carryover] = proc_buffered_char[channel];
5351 proc_buffered_char[channel] = -1;
5352 nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1);
5353 if (nbytes < 0)
5354 nbytes = 1;
5355 else
5356 nbytes = nbytes + 1;
5357 }
5358 #endif /* not VMS */
5359
5360 p->decoding_carryover = 0;
5361
5362 /* At this point, NBYTES holds number of bytes just received
5363 (including the one in proc_buffered_char[channel]). */
5364 if (nbytes <= 0)
5365 {
5366 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5367 return nbytes;
5368 coding->mode |= CODING_MODE_LAST_BLOCK;
5369 }
5370
5371 /* Now set NBYTES how many bytes we must decode. */
5372 nbytes += carryover;
5373
5374 /* Read and dispose of the process output. */
5375 outstream = p->filter;
5376 if (!NILP (outstream))
5377 {
5378 /* We inhibit quit here instead of just catching it so that
5379 hitting ^G when a filter happens to be running won't screw
5380 it up. */
5381 int count = SPECPDL_INDEX ();
5382 Lisp_Object odeactivate;
5383 Lisp_Object obuffer, okeymap;
5384 Lisp_Object text;
5385 int outer_running_asynch_code = running_asynch_code;
5386 int waiting = waiting_for_user_input_p;
5387
5388 /* No need to gcpro these, because all we do with them later
5389 is test them for EQness, and none of them should be a string. */
5390 odeactivate = Vdeactivate_mark;
5391 XSETBUFFER (obuffer, current_buffer);
5392 okeymap = current_buffer->keymap;
5393
5394 specbind (Qinhibit_quit, Qt);
5395 specbind (Qlast_nonmenu_event, Qt);
5396
5397 /* In case we get recursively called,
5398 and we already saved the match data nonrecursively,
5399 save the same match data in safely recursive fashion. */
5400 if (outer_running_asynch_code)
5401 {
5402 Lisp_Object tem;
5403 /* Don't clobber the CURRENT match data, either! */
5404 tem = Fmatch_data (Qnil, Qnil, Qnil);
5405 restore_search_regs ();
5406 record_unwind_save_match_data ();
5407 Fset_match_data (tem, Qt);
5408 }
5409
5410 /* For speed, if a search happens within this code,
5411 save the match data in a special nonrecursive fashion. */
5412 running_asynch_code = 1;
5413
5414 decode_coding_c_string (coding, chars, nbytes, Qt);
5415 text = coding->dst_object;
5416 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5417 /* A new coding system might be found. */
5418 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5419 {
5420 p->decode_coding_system = Vlast_coding_system_used;
5421
5422 /* Don't call setup_coding_system for
5423 proc_decode_coding_system[channel] here. It is done in
5424 detect_coding called via decode_coding above. */
5425
5426 /* If a coding system for encoding is not yet decided, we set
5427 it as the same as coding-system for decoding.
5428
5429 But, before doing that we must check if
5430 proc_encode_coding_system[p->outfd] surely points to a
5431 valid memory because p->outfd will be changed once EOF is
5432 sent to the process. */
5433 if (NILP (p->encode_coding_system)
5434 && proc_encode_coding_system[p->outfd])
5435 {
5436 p->encode_coding_system
5437 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5438 setup_coding_system (p->encode_coding_system,
5439 proc_encode_coding_system[p->outfd]);
5440 }
5441 }
5442
5443 if (coding->carryover_bytes > 0)
5444 {
5445 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5446 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
5447 bcopy (coding->carryover, SDATA (p->decoding_buf),
5448 coding->carryover_bytes);
5449 p->decoding_carryover = coding->carryover_bytes;
5450 }
5451 if (SBYTES (text) > 0)
5452 internal_condition_case_1 (read_process_output_call,
5453 Fcons (outstream,
5454 Fcons (proc, Fcons (text, Qnil))),
5455 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5456 read_process_output_error_handler);
5457
5458 /* If we saved the match data nonrecursively, restore it now. */
5459 restore_search_regs ();
5460 running_asynch_code = outer_running_asynch_code;
5461
5462 /* Handling the process output should not deactivate the mark. */
5463 Vdeactivate_mark = odeactivate;
5464
5465 /* Restore waiting_for_user_input_p as it was
5466 when we were called, in case the filter clobbered it. */
5467 waiting_for_user_input_p = waiting;
5468
5469 #if 0 /* Call record_asynch_buffer_change unconditionally,
5470 because we might have changed minor modes or other things
5471 that affect key bindings. */
5472 if (! EQ (Fcurrent_buffer (), obuffer)
5473 || ! EQ (current_buffer->keymap, okeymap))
5474 #endif
5475 /* But do it only if the caller is actually going to read events.
5476 Otherwise there's no need to make him wake up, and it could
5477 cause trouble (for example it would make sit_for return). */
5478 if (waiting_for_user_input_p == -1)
5479 record_asynch_buffer_change ();
5480
5481 #ifdef VMS
5482 start_vms_process_read (vs);
5483 #endif
5484 unbind_to (count, Qnil);
5485 return nbytes;
5486 }
5487
5488 /* If no filter, write into buffer if it isn't dead. */
5489 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
5490 {
5491 Lisp_Object old_read_only;
5492 int old_begv, old_zv;
5493 int old_begv_byte, old_zv_byte;
5494 Lisp_Object odeactivate;
5495 int before, before_byte;
5496 int opoint_byte;
5497 Lisp_Object text;
5498 struct buffer *b;
5499
5500 odeactivate = Vdeactivate_mark;
5501
5502 Fset_buffer (p->buffer);
5503 opoint = PT;
5504 opoint_byte = PT_BYTE;
5505 old_read_only = current_buffer->read_only;
5506 old_begv = BEGV;
5507 old_zv = ZV;
5508 old_begv_byte = BEGV_BYTE;
5509 old_zv_byte = ZV_BYTE;
5510
5511 current_buffer->read_only = Qnil;
5512
5513 /* Insert new output into buffer
5514 at the current end-of-output marker,
5515 thus preserving logical ordering of input and output. */
5516 if (XMARKER (p->mark)->buffer)
5517 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
5518 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
5519 ZV_BYTE));
5520 else
5521 SET_PT_BOTH (ZV, ZV_BYTE);
5522 before = PT;
5523 before_byte = PT_BYTE;
5524
5525 /* If the output marker is outside of the visible region, save
5526 the restriction and widen. */
5527 if (! (BEGV <= PT && PT <= ZV))
5528 Fwiden ();
5529
5530 decode_coding_c_string (coding, chars, nbytes, Qt);
5531 text = coding->dst_object;
5532 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5533 /* A new coding system might be found. See the comment in the
5534 similar code in the previous `if' block. */
5535 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5536 {
5537 p->decode_coding_system = Vlast_coding_system_used;
5538 if (NILP (p->encode_coding_system)
5539 && proc_encode_coding_system[p->outfd])
5540 {
5541 p->encode_coding_system
5542 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5543 setup_coding_system (p->encode_coding_system,
5544 proc_encode_coding_system[p->outfd]);
5545 }
5546 }
5547 if (coding->carryover_bytes > 0)
5548 {
5549 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5550 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
5551 bcopy (coding->carryover, SDATA (p->decoding_buf),
5552 coding->carryover_bytes);
5553 p->decoding_carryover = coding->carryover_bytes;
5554 }
5555 /* Adjust the multibyteness of TEXT to that of the buffer. */
5556 if (NILP (current_buffer->enable_multibyte_characters)
5557 != ! STRING_MULTIBYTE (text))
5558 text = (STRING_MULTIBYTE (text)
5559 ? Fstring_as_unibyte (text)
5560 : Fstring_to_multibyte (text));
5561 /* Insert before markers in case we are inserting where
5562 the buffer's mark is, and the user's next command is Meta-y. */
5563 insert_from_string_before_markers (text, 0, 0,
5564 SCHARS (text), SBYTES (text), 0);
5565
5566 /* Make sure the process marker's position is valid when the
5567 process buffer is changed in the signal_after_change above.
5568 W3 is known to do that. */
5569 if (BUFFERP (p->buffer)
5570 && (b = XBUFFER (p->buffer), b != current_buffer))
5571 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
5572 else
5573 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
5574
5575 update_mode_lines++;
5576
5577 /* Make sure opoint and the old restrictions
5578 float ahead of any new text just as point would. */
5579 if (opoint >= before)
5580 {
5581 opoint += PT - before;
5582 opoint_byte += PT_BYTE - before_byte;
5583 }
5584 if (old_begv > before)
5585 {
5586 old_begv += PT - before;
5587 old_begv_byte += PT_BYTE - before_byte;
5588 }
5589 if (old_zv >= before)
5590 {
5591 old_zv += PT - before;
5592 old_zv_byte += PT_BYTE - before_byte;
5593 }
5594
5595 /* If the restriction isn't what it should be, set it. */
5596 if (old_begv != BEGV || old_zv != ZV)
5597 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
5598
5599 /* Handling the process output should not deactivate the mark. */
5600 Vdeactivate_mark = odeactivate;
5601
5602 current_buffer->read_only = old_read_only;
5603 SET_PT_BOTH (opoint, opoint_byte);
5604 set_buffer_internal (old);
5605 }
5606 #ifdef VMS
5607 start_vms_process_read (vs);
5608 #endif
5609 return nbytes;
5610 }
5611
5612 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
5613 0, 0, 0,
5614 doc: /* Returns non-nil if Emacs is waiting for input from the user.
5615 This is intended for use by asynchronous process output filters and sentinels. */)
5616 ()
5617 {
5618 return (waiting_for_user_input_p ? Qt : Qnil);
5619 }
5620 \f
5621 /* Sending data to subprocess */
5622
5623 jmp_buf send_process_frame;
5624 Lisp_Object process_sent_to;
5625
5626 SIGTYPE
5627 send_process_trap ()
5628 {
5629 SIGNAL_THREAD_CHECK (SIGPIPE);
5630 sigunblock (sigmask (SIGPIPE));
5631 longjmp (send_process_frame, 1);
5632 }
5633
5634 /* Send some data to process PROC.
5635 BUF is the beginning of the data; LEN is the number of characters.
5636 OBJECT is the Lisp object that the data comes from. If OBJECT is
5637 nil or t, it means that the data comes from C string.
5638
5639 If OBJECT is not nil, the data is encoded by PROC's coding-system
5640 for encoding before it is sent.
5641
5642 This function can evaluate Lisp code and can garbage collect. */
5643
5644 static void
5645 send_process (proc, buf, len, object)
5646 volatile Lisp_Object proc;
5647 unsigned char *volatile buf;
5648 volatile int len;
5649 volatile Lisp_Object object;
5650 {
5651 /* Use volatile to protect variables from being clobbered by longjmp. */
5652 struct Lisp_Process *p = XPROCESS (proc);
5653 int rv;
5654 struct coding_system *coding;
5655 struct gcpro gcpro1;
5656 SIGTYPE (*volatile old_sigpipe) ();
5657
5658 GCPRO1 (object);
5659
5660 #ifdef VMS
5661 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
5662 #endif /* VMS */
5663
5664 if (p->raw_status_new)
5665 update_status (p);
5666 if (! EQ (p->status, Qrun))
5667 error ("Process %s not running", SDATA (p->name));
5668 if (p->outfd < 0)
5669 error ("Output file descriptor of %s is closed", SDATA (p->name));
5670
5671 coding = proc_encode_coding_system[p->outfd];
5672 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5673
5674 if ((STRINGP (object) && STRING_MULTIBYTE (object))
5675 || (BUFFERP (object)
5676 && !NILP (XBUFFER (object)->enable_multibyte_characters))
5677 || EQ (object, Qt))
5678 {
5679 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
5680 /* The coding system for encoding was changed to raw-text
5681 because we sent a unibyte text previously. Now we are
5682 sending a multibyte text, thus we must encode it by the
5683 original coding system specified for the current process. */
5684 setup_coding_system (p->encode_coding_system, coding);
5685 coding->src_multibyte = 1;
5686 }
5687 else
5688 {
5689 /* For sending a unibyte text, character code conversion should
5690 not take place but EOL conversion should. So, setup raw-text
5691 or one of the subsidiary if we have not yet done it. */
5692 if (CODING_REQUIRE_ENCODING (coding))
5693 {
5694 if (CODING_REQUIRE_FLUSHING (coding))
5695 {
5696 /* But, before changing the coding, we must flush out data. */
5697 coding->mode |= CODING_MODE_LAST_BLOCK;
5698 send_process (proc, "", 0, Qt);
5699 coding->mode &= CODING_MODE_LAST_BLOCK;
5700 }
5701 setup_coding_system (raw_text_coding_system
5702 (Vlast_coding_system_used),
5703 coding);
5704 coding->src_multibyte = 0;
5705 }
5706 }
5707 coding->dst_multibyte = 0;
5708
5709 if (CODING_REQUIRE_ENCODING (coding))
5710 {
5711 coding->dst_object = Qt;
5712 if (BUFFERP (object))
5713 {
5714 int from_byte, from, to;
5715 int save_pt, save_pt_byte;
5716 struct buffer *cur = current_buffer;
5717
5718 set_buffer_internal (XBUFFER (object));
5719 save_pt = PT, save_pt_byte = PT_BYTE;
5720
5721 from_byte = PTR_BYTE_POS (buf);
5722 from = BYTE_TO_CHAR (from_byte);
5723 to = BYTE_TO_CHAR (from_byte + len);
5724 TEMP_SET_PT_BOTH (from, from_byte);
5725 encode_coding_object (coding, object, from, from_byte,
5726 to, from_byte + len, Qt);
5727 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
5728 set_buffer_internal (cur);
5729 }
5730 else if (STRINGP (object))
5731 {
5732 encode_coding_string (coding, object, 1);
5733 }
5734 else
5735 {
5736 coding->dst_object = make_unibyte_string (buf, len);
5737 coding->produced = len;
5738 }
5739
5740 len = coding->produced;
5741 buf = SDATA (coding->dst_object);
5742 }
5743
5744 #ifdef VMS
5745 vs = get_vms_process_pointer (p->pid);
5746 if (vs == 0)
5747 error ("Could not find this process: %x", p->pid);
5748 else if (write_to_vms_process (vs, buf, len))
5749 ;
5750 #else /* not VMS */
5751
5752 if (pty_max_bytes == 0)
5753 {
5754 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5755 pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
5756 if (pty_max_bytes < 0)
5757 pty_max_bytes = 250;
5758 #else
5759 pty_max_bytes = 250;
5760 #endif
5761 /* Deduct one, to leave space for the eof. */
5762 pty_max_bytes--;
5763 }
5764
5765 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5766 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5767 when returning with longjmp despite being declared volatile. */
5768 if (!setjmp (send_process_frame))
5769 {
5770 process_sent_to = proc;
5771 while (len > 0)
5772 {
5773 int this = len;
5774
5775 /* Decide how much data we can send in one batch.
5776 Long lines need to be split into multiple batches. */
5777 if (p->pty_flag)
5778 {
5779 /* Starting this at zero is always correct when not the first
5780 iteration because the previous iteration ended by sending C-d.
5781 It may not be correct for the first iteration
5782 if a partial line was sent in a separate send_process call.
5783 If that proves worth handling, we need to save linepos
5784 in the process object. */
5785 int linepos = 0;
5786 unsigned char *ptr = (unsigned char *) buf;
5787 unsigned char *end = (unsigned char *) buf + len;
5788
5789 /* Scan through this text for a line that is too long. */
5790 while (ptr != end && linepos < pty_max_bytes)
5791 {
5792 if (*ptr == '\n')
5793 linepos = 0;
5794 else
5795 linepos++;
5796 ptr++;
5797 }
5798 /* If we found one, break the line there
5799 and put in a C-d to force the buffer through. */
5800 this = ptr - buf;
5801 }
5802
5803 /* Send this batch, using one or more write calls. */
5804 while (this > 0)
5805 {
5806 int outfd = p->outfd;
5807 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
5808 #ifdef DATAGRAM_SOCKETS
5809 if (DATAGRAM_CHAN_P (outfd))
5810 {
5811 rv = sendto (outfd, (char *) buf, this,
5812 0, datagram_address[outfd].sa,
5813 datagram_address[outfd].len);
5814 if (rv < 0 && errno == EMSGSIZE)
5815 {
5816 signal (SIGPIPE, old_sigpipe);
5817 report_file_error ("sending datagram",
5818 Fcons (proc, Qnil));
5819 }
5820 }
5821 else
5822 #endif
5823 {
5824 rv = emacs_write (outfd, (char *) buf, this);
5825 #ifdef ADAPTIVE_READ_BUFFERING
5826 if (p->read_output_delay > 0
5827 && p->adaptive_read_buffering == 1)
5828 {
5829 p->read_output_delay = 0;
5830 process_output_delay_count--;
5831 p->read_output_skip = 0;
5832 }
5833 #endif
5834 }
5835 signal (SIGPIPE, old_sigpipe);
5836
5837 if (rv < 0)
5838 {
5839 if (0
5840 #ifdef EWOULDBLOCK
5841 || errno == EWOULDBLOCK
5842 #endif
5843 #ifdef EAGAIN
5844 || errno == EAGAIN
5845 #endif
5846 )
5847 /* Buffer is full. Wait, accepting input;
5848 that may allow the program
5849 to finish doing output and read more. */
5850 {
5851 int offset = 0;
5852
5853 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5854 /* A gross hack to work around a bug in FreeBSD.
5855 In the following sequence, read(2) returns
5856 bogus data:
5857
5858 write(2) 1022 bytes
5859 write(2) 954 bytes, get EAGAIN
5860 read(2) 1024 bytes in process_read_output
5861 read(2) 11 bytes in process_read_output
5862
5863 That is, read(2) returns more bytes than have
5864 ever been written successfully. The 1033 bytes
5865 read are the 1022 bytes written successfully
5866 after processing (for example with CRs added if
5867 the terminal is set up that way which it is
5868 here). The same bytes will be seen again in a
5869 later read(2), without the CRs. */
5870
5871 if (errno == EAGAIN)
5872 {
5873 int flags = FWRITE;
5874 ioctl (p->outfd, TIOCFLUSH, &flags);
5875 }
5876 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5877
5878 /* Running filters might relocate buffers or strings.
5879 Arrange to relocate BUF. */
5880 if (BUFFERP (object))
5881 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
5882 else if (STRINGP (object))
5883 offset = buf - SDATA (object);
5884
5885 #ifdef EMACS_HAS_USECS
5886 wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
5887 #else
5888 wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
5889 #endif
5890
5891 if (BUFFERP (object))
5892 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
5893 else if (STRINGP (object))
5894 buf = offset + SDATA (object);
5895
5896 rv = 0;
5897 }
5898 else
5899 /* This is a real error. */
5900 report_file_error ("writing to process", Fcons (proc, Qnil));
5901 }
5902 buf += rv;
5903 len -= rv;
5904 this -= rv;
5905 }
5906
5907 /* If we sent just part of the string, put in an EOF (C-d)
5908 to force it through, before we send the rest. */
5909 if (len > 0)
5910 Fprocess_send_eof (proc);
5911 }
5912 }
5913 #endif /* not VMS */
5914 else
5915 {
5916 signal (SIGPIPE, old_sigpipe);
5917 #ifndef VMS
5918 proc = process_sent_to;
5919 p = XPROCESS (proc);
5920 #endif
5921 p->raw_status_new = 0;
5922 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
5923 p->tick = ++process_tick;
5924 deactivate_process (proc);
5925 #ifdef VMS
5926 error ("Error writing to process %s; closed it", SDATA (p->name));
5927 #else
5928 error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
5929 #endif
5930 }
5931
5932 UNGCPRO;
5933 }
5934
5935 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
5936 3, 3, 0,
5937 doc: /* Send current contents of region as input to PROCESS.
5938 PROCESS may be a process, a buffer, the name of a process or buffer, or
5939 nil, indicating the current buffer's process.
5940 Called from program, takes three arguments, PROCESS, START and END.
5941 If the region is more than 500 characters long,
5942 it is sent in several bunches. This may happen even for shorter regions.
5943 Output from processes can arrive in between bunches. */)
5944 (process, start, end)
5945 Lisp_Object process, start, end;
5946 {
5947 Lisp_Object proc;
5948 int start1, end1;
5949
5950 proc = get_process (process);
5951 validate_region (&start, &end);
5952
5953 if (XINT (start) < GPT && XINT (end) > GPT)
5954 move_gap (XINT (start));
5955
5956 start1 = CHAR_TO_BYTE (XINT (start));
5957 end1 = CHAR_TO_BYTE (XINT (end));
5958 send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
5959 Fcurrent_buffer ());
5960
5961 return Qnil;
5962 }
5963
5964 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
5965 2, 2, 0,
5966 doc: /* Send PROCESS the contents of STRING as input.
5967 PROCESS may be a process, a buffer, the name of a process or buffer, or
5968 nil, indicating the current buffer's process.
5969 If STRING is more than 500 characters long,
5970 it is sent in several bunches. This may happen even for shorter strings.
5971 Output from processes can arrive in between bunches. */)
5972 (process, string)
5973 Lisp_Object process, string;
5974 {
5975 Lisp_Object proc;
5976 CHECK_STRING (string);
5977 proc = get_process (process);
5978 send_process (proc, SDATA (string),
5979 SBYTES (string), string);
5980 return Qnil;
5981 }
5982 \f
5983 /* Return the foreground process group for the tty/pty that
5984 the process P uses. */
5985 static int
5986 emacs_get_tty_pgrp (p)
5987 struct Lisp_Process *p;
5988 {
5989 int gid = -1;
5990
5991 #ifdef TIOCGPGRP
5992 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
5993 {
5994 int fd;
5995 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5996 master side. Try the slave side. */
5997 fd = emacs_open (SDATA (p->tty_name), O_RDONLY, 0);
5998
5999 if (fd != -1)
6000 {
6001 ioctl (fd, TIOCGPGRP, &gid);
6002 emacs_close (fd);
6003 }
6004 }
6005 #endif /* defined (TIOCGPGRP ) */
6006
6007 return gid;
6008 }
6009
6010 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6011 Sprocess_running_child_p, 0, 1, 0,
6012 doc: /* Return t if PROCESS has given the terminal to a child.
6013 If the operating system does not make it possible to find out,
6014 return t unconditionally. */)
6015 (process)
6016 Lisp_Object process;
6017 {
6018 /* Initialize in case ioctl doesn't exist or gives an error,
6019 in a way that will cause returning t. */
6020 int gid;
6021 Lisp_Object proc;
6022 struct Lisp_Process *p;
6023
6024 proc = get_process (process);
6025 p = XPROCESS (proc);
6026
6027 if (!EQ (p->type, Qreal))
6028 error ("Process %s is not a subprocess",
6029 SDATA (p->name));
6030 if (p->infd < 0)
6031 error ("Process %s is not active",
6032 SDATA (p->name));
6033
6034 gid = emacs_get_tty_pgrp (p);
6035
6036 if (gid == p->pid)
6037 return Qnil;
6038 return Qt;
6039 }
6040 \f
6041 /* send a signal number SIGNO to PROCESS.
6042 If CURRENT_GROUP is t, that means send to the process group
6043 that currently owns the terminal being used to communicate with PROCESS.
6044 This is used for various commands in shell mode.
6045 If CURRENT_GROUP is lambda, that means send to the process group
6046 that currently owns the terminal, but only if it is NOT the shell itself.
6047
6048 If NOMSG is zero, insert signal-announcements into process's buffers
6049 right away.
6050
6051 If we can, we try to signal PROCESS by sending control characters
6052 down the pty. This allows us to signal inferiors who have changed
6053 their uid, for which killpg would return an EPERM error. */
6054
6055 static void
6056 process_send_signal (process, signo, current_group, nomsg)
6057 Lisp_Object process;
6058 int signo;
6059 Lisp_Object current_group;
6060 int nomsg;
6061 {
6062 Lisp_Object proc;
6063 register struct Lisp_Process *p;
6064 int gid;
6065 int no_pgrp = 0;
6066
6067 proc = get_process (process);
6068 p = XPROCESS (proc);
6069
6070 if (!EQ (p->type, Qreal))
6071 error ("Process %s is not a subprocess",
6072 SDATA (p->name));
6073 if (p->infd < 0)
6074 error ("Process %s is not active",
6075 SDATA (p->name));
6076
6077 if (!p->pty_flag)
6078 current_group = Qnil;
6079
6080 /* If we are using pgrps, get a pgrp number and make it negative. */
6081 if (NILP (current_group))
6082 /* Send the signal to the shell's process group. */
6083 gid = p->pid;
6084 else
6085 {
6086 #ifdef SIGNALS_VIA_CHARACTERS
6087 /* If possible, send signals to the entire pgrp
6088 by sending an input character to it. */
6089
6090 /* TERMIOS is the latest and bestest, and seems most likely to
6091 work. If the system has it, use it. */
6092 #ifdef HAVE_TERMIOS
6093 struct termios t;
6094 cc_t *sig_char = NULL;
6095
6096 tcgetattr (p->infd, &t);
6097
6098 switch (signo)
6099 {
6100 case SIGINT:
6101 sig_char = &t.c_cc[VINTR];
6102 break;
6103
6104 case SIGQUIT:
6105 sig_char = &t.c_cc[VQUIT];
6106 break;
6107
6108 case SIGTSTP:
6109 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
6110 sig_char = &t.c_cc[VSWTCH];
6111 #else
6112 sig_char = &t.c_cc[VSUSP];
6113 #endif
6114 break;
6115 }
6116
6117 if (sig_char && *sig_char != CDISABLE)
6118 {
6119 send_process (proc, sig_char, 1, Qnil);
6120 return;
6121 }
6122 /* If we can't send the signal with a character,
6123 fall through and send it another way. */
6124 #else /* ! HAVE_TERMIOS */
6125
6126 /* On Berkeley descendants, the following IOCTL's retrieve the
6127 current control characters. */
6128 #if defined (TIOCGLTC) && defined (TIOCGETC)
6129
6130 struct tchars c;
6131 struct ltchars lc;
6132
6133 switch (signo)
6134 {
6135 case SIGINT:
6136 ioctl (p->infd, TIOCGETC, &c);
6137 send_process (proc, &c.t_intrc, 1, Qnil);
6138 return;
6139 case SIGQUIT:
6140 ioctl (p->infd, TIOCGETC, &c);
6141 send_process (proc, &c.t_quitc, 1, Qnil);
6142 return;
6143 #ifdef SIGTSTP
6144 case SIGTSTP:
6145 ioctl (p->infd, TIOCGLTC, &lc);
6146 send_process (proc, &lc.t_suspc, 1, Qnil);
6147 return;
6148 #endif /* ! defined (SIGTSTP) */
6149 }
6150
6151 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6152
6153 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
6154 characters. */
6155 #ifdef TCGETA
6156 struct termio t;
6157 switch (signo)
6158 {
6159 case SIGINT:
6160 ioctl (p->infd, TCGETA, &t);
6161 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
6162 return;
6163 case SIGQUIT:
6164 ioctl (p->infd, TCGETA, &t);
6165 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
6166 return;
6167 #ifdef SIGTSTP
6168 case SIGTSTP:
6169 ioctl (p->infd, TCGETA, &t);
6170 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
6171 return;
6172 #endif /* ! defined (SIGTSTP) */
6173 }
6174 #else /* ! defined (TCGETA) */
6175 Your configuration files are messed up.
6176 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
6177 you'd better be using one of the alternatives above! */
6178 #endif /* ! defined (TCGETA) */
6179 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6180 /* In this case, the code above should alway return. */
6181 abort ();
6182 #endif /* ! defined HAVE_TERMIOS */
6183
6184 /* The code above may fall through if it can't
6185 handle the signal. */
6186 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6187
6188 #ifdef TIOCGPGRP
6189 /* Get the current pgrp using the tty itself, if we have that.
6190 Otherwise, use the pty to get the pgrp.
6191 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6192 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6193 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6194 His patch indicates that if TIOCGPGRP returns an error, then
6195 we should just assume that p->pid is also the process group id. */
6196
6197 gid = emacs_get_tty_pgrp (p);
6198
6199 if (gid == -1)
6200 /* If we can't get the information, assume
6201 the shell owns the tty. */
6202 gid = p->pid;
6203
6204 /* It is not clear whether anything really can set GID to -1.
6205 Perhaps on some system one of those ioctls can or could do so.
6206 Or perhaps this is vestigial. */
6207 if (gid == -1)
6208 no_pgrp = 1;
6209 #else /* ! defined (TIOCGPGRP ) */
6210 /* Can't select pgrps on this system, so we know that
6211 the child itself heads the pgrp. */
6212 gid = p->pid;
6213 #endif /* ! defined (TIOCGPGRP ) */
6214
6215 /* If current_group is lambda, and the shell owns the terminal,
6216 don't send any signal. */
6217 if (EQ (current_group, Qlambda) && gid == p->pid)
6218 return;
6219 }
6220
6221 switch (signo)
6222 {
6223 #ifdef SIGCONT
6224 case SIGCONT:
6225 p->raw_status_new = 0;
6226 p->status = Qrun;
6227 p->tick = ++process_tick;
6228 if (!nomsg)
6229 status_notify (NULL);
6230 break;
6231 #endif /* ! defined (SIGCONT) */
6232 case SIGINT:
6233 #ifdef VMS
6234 send_process (proc, "\003", 1, Qnil); /* ^C */
6235 goto whoosh;
6236 #endif
6237 case SIGQUIT:
6238 #ifdef VMS
6239 send_process (proc, "\031", 1, Qnil); /* ^Y */
6240 goto whoosh;
6241 #endif
6242 case SIGKILL:
6243 #ifdef VMS
6244 sys$forcex (&(p->pid), 0, 1);
6245 whoosh:
6246 #endif
6247 flush_pending_output (p->infd);
6248 break;
6249 }
6250
6251 /* If we don't have process groups, send the signal to the immediate
6252 subprocess. That isn't really right, but it's better than any
6253 obvious alternative. */
6254 if (no_pgrp)
6255 {
6256 kill (p->pid, signo);
6257 return;
6258 }
6259
6260 /* gid may be a pid, or minus a pgrp's number */
6261 #ifdef TIOCSIGSEND
6262 if (!NILP (current_group))
6263 {
6264 if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
6265 EMACS_KILLPG (gid, signo);
6266 }
6267 else
6268 {
6269 gid = - p->pid;
6270 kill (gid, signo);
6271 }
6272 #else /* ! defined (TIOCSIGSEND) */
6273 EMACS_KILLPG (gid, signo);
6274 #endif /* ! defined (TIOCSIGSEND) */
6275 }
6276
6277 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6278 doc: /* Interrupt process PROCESS.
6279 PROCESS may be a process, a buffer, or the name of a process or buffer.
6280 No arg or nil means current buffer's process.
6281 Second arg CURRENT-GROUP non-nil means send signal to
6282 the current process-group of the process's controlling terminal
6283 rather than to the process's own process group.
6284 If the process is a shell, this means interrupt current subjob
6285 rather than the shell.
6286
6287 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6288 don't send the signal. */)
6289 (process, current_group)
6290 Lisp_Object process, current_group;
6291 {
6292 process_send_signal (process, SIGINT, current_group, 0);
6293 return process;
6294 }
6295
6296 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6297 doc: /* Kill process PROCESS. May be process or name of one.
6298 See function `interrupt-process' for more details on usage. */)
6299 (process, current_group)
6300 Lisp_Object process, current_group;
6301 {
6302 process_send_signal (process, SIGKILL, current_group, 0);
6303 return process;
6304 }
6305
6306 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6307 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6308 See function `interrupt-process' for more details on usage. */)
6309 (process, current_group)
6310 Lisp_Object process, current_group;
6311 {
6312 process_send_signal (process, SIGQUIT, current_group, 0);
6313 return process;
6314 }
6315
6316 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6317 doc: /* Stop process PROCESS. May be process or name of one.
6318 See function `interrupt-process' for more details on usage.
6319 If PROCESS is a network or serial process, inhibit handling of incoming
6320 traffic. */)
6321 (process, current_group)
6322 Lisp_Object process, current_group;
6323 {
6324 #ifdef HAVE_SOCKETS
6325 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
6326 {
6327 struct Lisp_Process *p;
6328
6329 p = XPROCESS (process);
6330 if (NILP (p->command)
6331 && p->infd >= 0)
6332 {
6333 FD_CLR (p->infd, &input_wait_mask);
6334 FD_CLR (p->infd, &non_keyboard_wait_mask);
6335 }
6336 p->command = Qt;
6337 return process;
6338 }
6339 #endif
6340 #ifndef SIGTSTP
6341 error ("No SIGTSTP support");
6342 #else
6343 process_send_signal (process, SIGTSTP, current_group, 0);
6344 #endif
6345 return process;
6346 }
6347
6348 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6349 doc: /* Continue process PROCESS. May be process or name of one.
6350 See function `interrupt-process' for more details on usage.
6351 If PROCESS is a network or serial process, resume handling of incoming
6352 traffic. */)
6353 (process, current_group)
6354 Lisp_Object process, current_group;
6355 {
6356 #ifdef HAVE_SOCKETS
6357 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
6358 {
6359 struct Lisp_Process *p;
6360
6361 p = XPROCESS (process);
6362 if (EQ (p->command, Qt)
6363 && p->infd >= 0
6364 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6365 {
6366 FD_SET (p->infd, &input_wait_mask);
6367 FD_SET (p->infd, &non_keyboard_wait_mask);
6368 #ifdef WINDOWSNT
6369 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6370 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6371 #endif
6372 #ifdef HAVE_TERMIOS
6373 tcflush (p->infd, TCIFLUSH);
6374 #endif
6375 }
6376 p->command = Qnil;
6377 return process;
6378 }
6379 #endif
6380 #ifdef SIGCONT
6381 process_send_signal (process, SIGCONT, current_group, 0);
6382 #else
6383 error ("No SIGCONT support");
6384 #endif
6385 return process;
6386 }
6387
6388 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6389 2, 2, "sProcess (name or number): \nnSignal code: ",
6390 doc: /* Send PROCESS the signal with code SIGCODE.
6391 PROCESS may also be a number specifying the process id of the
6392 process to signal; in this case, the process need not be a child of
6393 this Emacs.
6394 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6395 (process, sigcode)
6396 Lisp_Object process, sigcode;
6397 {
6398 pid_t pid;
6399
6400 if (INTEGERP (process))
6401 {
6402 pid = XINT (process);
6403 goto got_it;
6404 }
6405
6406 if (FLOATP (process))
6407 {
6408 pid = (pid_t) XFLOAT_DATA (process);
6409 goto got_it;
6410 }
6411
6412 if (STRINGP (process))
6413 {
6414 Lisp_Object tem;
6415 if (tem = Fget_process (process), NILP (tem))
6416 {
6417 pid = XINT (Fstring_to_number (process, make_number (10)));
6418 if (pid > 0)
6419 goto got_it;
6420 }
6421 process = tem;
6422 }
6423 else
6424 process = get_process (process);
6425
6426 if (NILP (process))
6427 return process;
6428
6429 CHECK_PROCESS (process);
6430 pid = XPROCESS (process)->pid;
6431 if (pid <= 0)
6432 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6433
6434 got_it:
6435
6436 #define parse_signal(NAME, VALUE) \
6437 else if (!xstrcasecmp (name, NAME)) \
6438 XSETINT (sigcode, VALUE)
6439
6440 if (INTEGERP (sigcode))
6441 ;
6442 else
6443 {
6444 unsigned char *name;
6445
6446 CHECK_SYMBOL (sigcode);
6447 name = SDATA (SYMBOL_NAME (sigcode));
6448
6449 if (!strncmp(name, "SIG", 3) || !strncmp(name, "sig", 3))
6450 name += 3;
6451
6452 if (0)
6453 ;
6454 #ifdef SIGUSR1
6455 parse_signal ("usr1", SIGUSR1);
6456 #endif
6457 #ifdef SIGUSR2
6458 parse_signal ("usr2", SIGUSR2);
6459 #endif
6460 #ifdef SIGTERM
6461 parse_signal ("term", SIGTERM);
6462 #endif
6463 #ifdef SIGHUP
6464 parse_signal ("hup", SIGHUP);
6465 #endif
6466 #ifdef SIGINT
6467 parse_signal ("int", SIGINT);
6468 #endif
6469 #ifdef SIGQUIT
6470 parse_signal ("quit", SIGQUIT);
6471 #endif
6472 #ifdef SIGILL
6473 parse_signal ("ill", SIGILL);
6474 #endif
6475 #ifdef SIGABRT
6476 parse_signal ("abrt", SIGABRT);
6477 #endif
6478 #ifdef SIGEMT
6479 parse_signal ("emt", SIGEMT);
6480 #endif
6481 #ifdef SIGKILL
6482 parse_signal ("kill", SIGKILL);
6483 #endif
6484 #ifdef SIGFPE
6485 parse_signal ("fpe", SIGFPE);
6486 #endif
6487 #ifdef SIGBUS
6488 parse_signal ("bus", SIGBUS);
6489 #endif
6490 #ifdef SIGSEGV
6491 parse_signal ("segv", SIGSEGV);
6492 #endif
6493 #ifdef SIGSYS
6494 parse_signal ("sys", SIGSYS);
6495 #endif
6496 #ifdef SIGPIPE
6497 parse_signal ("pipe", SIGPIPE);
6498 #endif
6499 #ifdef SIGALRM
6500 parse_signal ("alrm", SIGALRM);
6501 #endif
6502 #ifdef SIGURG
6503 parse_signal ("urg", SIGURG);
6504 #endif
6505 #ifdef SIGSTOP
6506 parse_signal ("stop", SIGSTOP);
6507 #endif
6508 #ifdef SIGTSTP
6509 parse_signal ("tstp", SIGTSTP);
6510 #endif
6511 #ifdef SIGCONT
6512 parse_signal ("cont", SIGCONT);
6513 #endif
6514 #ifdef SIGCHLD
6515 parse_signal ("chld", SIGCHLD);
6516 #endif
6517 #ifdef SIGTTIN
6518 parse_signal ("ttin", SIGTTIN);
6519 #endif
6520 #ifdef SIGTTOU
6521 parse_signal ("ttou", SIGTTOU);
6522 #endif
6523 #ifdef SIGIO
6524 parse_signal ("io", SIGIO);
6525 #endif
6526 #ifdef SIGXCPU
6527 parse_signal ("xcpu", SIGXCPU);
6528 #endif
6529 #ifdef SIGXFSZ
6530 parse_signal ("xfsz", SIGXFSZ);
6531 #endif
6532 #ifdef SIGVTALRM
6533 parse_signal ("vtalrm", SIGVTALRM);
6534 #endif
6535 #ifdef SIGPROF
6536 parse_signal ("prof", SIGPROF);
6537 #endif
6538 #ifdef SIGWINCH
6539 parse_signal ("winch", SIGWINCH);
6540 #endif
6541 #ifdef SIGINFO
6542 parse_signal ("info", SIGINFO);
6543 #endif
6544 else
6545 error ("Undefined signal name %s", name);
6546 }
6547
6548 #undef parse_signal
6549
6550 return make_number (kill (pid, XINT (sigcode)));
6551 }
6552
6553 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6554 doc: /* Make PROCESS see end-of-file in its input.
6555 EOF comes after any text already sent to it.
6556 PROCESS may be a process, a buffer, the name of a process or buffer, or
6557 nil, indicating the current buffer's process.
6558 If PROCESS is a network connection, or is a process communicating
6559 through a pipe (as opposed to a pty), then you cannot send any more
6560 text to PROCESS after you call this function.
6561 If PROCESS is a serial process, wait until all output written to the
6562 process has been transmitted to the serial port. */)
6563 (process)
6564 Lisp_Object process;
6565 {
6566 Lisp_Object proc;
6567 struct coding_system *coding;
6568
6569 if (DATAGRAM_CONN_P (process))
6570 return process;
6571
6572 proc = get_process (process);
6573 coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
6574
6575 /* Make sure the process is really alive. */
6576 if (XPROCESS (proc)->raw_status_new)
6577 update_status (XPROCESS (proc));
6578 if (! EQ (XPROCESS (proc)->status, Qrun))
6579 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6580
6581 if (CODING_REQUIRE_FLUSHING (coding))
6582 {
6583 coding->mode |= CODING_MODE_LAST_BLOCK;
6584 send_process (proc, "", 0, Qnil);
6585 }
6586
6587 #ifdef VMS
6588 send_process (proc, "\032", 1, Qnil); /* ^z */
6589 #else
6590 if (XPROCESS (proc)->pty_flag)
6591 send_process (proc, "\004", 1, Qnil);
6592 else if (EQ (XPROCESS (proc)->type, Qserial))
6593 {
6594 #ifdef HAVE_TERMIOS
6595 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6596 error ("tcdrain() failed: %s", emacs_strerror (errno));
6597 #endif
6598 /* Do nothing on Windows because writes are blocking. */
6599 }
6600 else
6601 {
6602 int old_outfd, new_outfd;
6603
6604 #ifdef HAVE_SHUTDOWN
6605 /* If this is a network connection, or socketpair is used
6606 for communication with the subprocess, call shutdown to cause EOF.
6607 (In some old system, shutdown to socketpair doesn't work.
6608 Then we just can't win.) */
6609 if (EQ (XPROCESS (proc)->type, Qnetwork)
6610 || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
6611 shutdown (XPROCESS (proc)->outfd, 1);
6612 /* In case of socketpair, outfd == infd, so don't close it. */
6613 if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
6614 emacs_close (XPROCESS (proc)->outfd);
6615 #else /* not HAVE_SHUTDOWN */
6616 emacs_close (XPROCESS (proc)->outfd);
6617 #endif /* not HAVE_SHUTDOWN */
6618 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6619 if (new_outfd < 0)
6620 abort ();
6621 old_outfd = XPROCESS (proc)->outfd;
6622
6623 if (!proc_encode_coding_system[new_outfd])
6624 proc_encode_coding_system[new_outfd]
6625 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
6626 bcopy (proc_encode_coding_system[old_outfd],
6627 proc_encode_coding_system[new_outfd],
6628 sizeof (struct coding_system));
6629 bzero (proc_encode_coding_system[old_outfd],
6630 sizeof (struct coding_system));
6631
6632 XPROCESS (proc)->outfd = new_outfd;
6633 }
6634 #endif /* VMS */
6635 return process;
6636 }
6637
6638 /* Kill all processes associated with `buffer'.
6639 If `buffer' is nil, kill all processes */
6640
6641 void
6642 kill_buffer_processes (buffer)
6643 Lisp_Object buffer;
6644 {
6645 Lisp_Object tail, proc;
6646
6647 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6648 {
6649 proc = XCDR (XCAR (tail));
6650 if (PROCESSP (proc)
6651 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
6652 {
6653 if (NETCONN_P (proc) || SERIALCONN_P (proc))
6654 Fdelete_process (proc);
6655 else if (XPROCESS (proc)->infd >= 0)
6656 process_send_signal (proc, SIGHUP, Qnil, 1);
6657 }
6658 }
6659 }
6660 \f
6661 /* On receipt of a signal that a child status has changed, loop asking
6662 about children with changed statuses until the system says there
6663 are no more.
6664
6665 All we do is change the status; we do not run sentinels or print
6666 notifications. That is saved for the next time keyboard input is
6667 done, in order to avoid timing errors.
6668
6669 ** WARNING: this can be called during garbage collection.
6670 Therefore, it must not be fooled by the presence of mark bits in
6671 Lisp objects.
6672
6673 ** USG WARNING: Although it is not obvious from the documentation
6674 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6675 signal() before executing at least one wait(), otherwise the
6676 handler will be called again, resulting in an infinite loop. The
6677 relevant portion of the documentation reads "SIGCLD signals will be
6678 queued and the signal-catching function will be continually
6679 reentered until the queue is empty". Invoking signal() causes the
6680 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6681 Inc.
6682
6683 ** Malloc WARNING: This should never call malloc either directly or
6684 indirectly; if it does, that is a bug */
6685
6686 #ifdef SIGCHLD
6687 SIGTYPE
6688 sigchld_handler (signo)
6689 int signo;
6690 {
6691 int old_errno = errno;
6692 Lisp_Object proc;
6693 register struct Lisp_Process *p;
6694 extern EMACS_TIME *input_available_clear_time;
6695
6696 SIGNAL_THREAD_CHECK (signo);
6697
6698 while (1)
6699 {
6700 pid_t pid;
6701 WAITTYPE w;
6702 Lisp_Object tail;
6703
6704 #ifdef WNOHANG
6705 #ifndef WUNTRACED
6706 #define WUNTRACED 0
6707 #endif /* no WUNTRACED */
6708 /* Keep trying to get a status until we get a definitive result. */
6709 do
6710 {
6711 errno = 0;
6712 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
6713 }
6714 while (pid < 0 && errno == EINTR);
6715
6716 if (pid <= 0)
6717 {
6718 /* PID == 0 means no processes found, PID == -1 means a real
6719 failure. We have done all our job, so return. */
6720
6721 /* USG systems forget handlers when they are used;
6722 must reestablish each time */
6723 #if defined (USG) && !defined (POSIX_SIGNALS)
6724 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
6725 #endif
6726 errno = old_errno;
6727 return;
6728 }
6729 #else
6730 pid = wait (&w);
6731 #endif /* no WNOHANG */
6732
6733 /* Find the process that signaled us, and record its status. */
6734
6735 /* The process can have been deleted by Fdelete_process. */
6736 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
6737 {
6738 Lisp_Object xpid = XCAR (tail);
6739 if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
6740 || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
6741 {
6742 XSETCAR (tail, Qnil);
6743 goto sigchld_end_of_loop;
6744 }
6745 }
6746
6747 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6748 p = 0;
6749 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6750 {
6751 proc = XCDR (XCAR (tail));
6752 p = XPROCESS (proc);
6753 if (EQ (p->type, Qreal) && p->pid == pid)
6754 break;
6755 p = 0;
6756 }
6757
6758 /* Look for an asynchronous process whose pid hasn't been filled
6759 in yet. */
6760 if (p == 0)
6761 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6762 {
6763 proc = XCDR (XCAR (tail));
6764 p = XPROCESS (proc);
6765 if (p->pid == -1)
6766 break;
6767 p = 0;
6768 }
6769
6770 /* Change the status of the process that was found. */
6771 if (p != 0)
6772 {
6773 union { int i; WAITTYPE wt; } u;
6774 int clear_desc_flag = 0;
6775
6776 p->tick = ++process_tick;
6777 u.wt = w;
6778 p->raw_status = u.i;
6779 p->raw_status_new = 1;
6780
6781 /* If process has terminated, stop waiting for its output. */
6782 if ((WIFSIGNALED (w) || WIFEXITED (w))
6783 && p->infd >= 0)
6784 clear_desc_flag = 1;
6785
6786 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6787 if (clear_desc_flag)
6788 {
6789 FD_CLR (p->infd, &input_wait_mask);
6790 FD_CLR (p->infd, &non_keyboard_wait_mask);
6791 }
6792
6793 /* Tell wait_reading_process_output that it needs to wake up and
6794 look around. */
6795 if (input_available_clear_time)
6796 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6797 }
6798
6799 /* There was no asynchronous process found for that pid: we have
6800 a synchronous process. */
6801 else
6802 {
6803 synch_process_alive = 0;
6804
6805 /* Report the status of the synchronous process. */
6806 if (WIFEXITED (w))
6807 synch_process_retcode = WRETCODE (w);
6808 else if (WIFSIGNALED (w))
6809 synch_process_termsig = WTERMSIG (w);
6810
6811 /* Tell wait_reading_process_output that it needs to wake up and
6812 look around. */
6813 if (input_available_clear_time)
6814 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6815 }
6816
6817 sigchld_end_of_loop:
6818 ;
6819
6820 /* On some systems, we must return right away.
6821 If any more processes want to signal us, we will
6822 get another signal.
6823 Otherwise (on systems that have WNOHANG), loop around
6824 to use up all the processes that have something to tell us. */
6825 #if (defined WINDOWSNT \
6826 || (defined USG && !defined GNU_LINUX \
6827 && !(defined HPUX && defined WNOHANG)))
6828 #if defined (USG) && ! defined (POSIX_SIGNALS)
6829 signal (signo, sigchld_handler);
6830 #endif
6831 errno = old_errno;
6832 return;
6833 #endif /* USG, but not HPUX with WNOHANG */
6834 }
6835 }
6836 #endif /* SIGCHLD */
6837 \f
6838
6839 static Lisp_Object
6840 exec_sentinel_unwind (data)
6841 Lisp_Object data;
6842 {
6843 XPROCESS (XCAR (data))->sentinel = XCDR (data);
6844 return Qnil;
6845 }
6846
6847 static Lisp_Object
6848 exec_sentinel_error_handler (error)
6849 Lisp_Object error;
6850 {
6851 cmd_error_internal (error, "error in process sentinel: ");
6852 Vinhibit_quit = Qt;
6853 update_echo_area ();
6854 Fsleep_for (make_number (2), Qnil);
6855 return Qt;
6856 }
6857
6858 static void
6859 exec_sentinel (proc, reason)
6860 Lisp_Object proc, reason;
6861 {
6862 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
6863 register struct Lisp_Process *p = XPROCESS (proc);
6864 int count = SPECPDL_INDEX ();
6865 int outer_running_asynch_code = running_asynch_code;
6866 int waiting = waiting_for_user_input_p;
6867
6868 if (inhibit_sentinels)
6869 return;
6870
6871 /* No need to gcpro these, because all we do with them later
6872 is test them for EQness, and none of them should be a string. */
6873 odeactivate = Vdeactivate_mark;
6874 XSETBUFFER (obuffer, current_buffer);
6875 okeymap = current_buffer->keymap;
6876
6877 sentinel = p->sentinel;
6878 if (NILP (sentinel))
6879 return;
6880
6881 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6882 assure that it gets restored no matter how the sentinel exits. */
6883 p->sentinel = Qnil;
6884 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
6885 /* Inhibit quit so that random quits don't screw up a running filter. */
6886 specbind (Qinhibit_quit, Qt);
6887 specbind (Qlast_nonmenu_event, Qt);
6888
6889 /* In case we get recursively called,
6890 and we already saved the match data nonrecursively,
6891 save the same match data in safely recursive fashion. */
6892 if (outer_running_asynch_code)
6893 {
6894 Lisp_Object tem;
6895 tem = Fmatch_data (Qnil, Qnil, Qnil);
6896 restore_search_regs ();
6897 record_unwind_save_match_data ();
6898 Fset_match_data (tem, Qt);
6899 }
6900
6901 /* For speed, if a search happens within this code,
6902 save the match data in a special nonrecursive fashion. */
6903 running_asynch_code = 1;
6904
6905 internal_condition_case_1 (read_process_output_call,
6906 Fcons (sentinel,
6907 Fcons (proc, Fcons (reason, Qnil))),
6908 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6909 exec_sentinel_error_handler);
6910
6911 /* If we saved the match data nonrecursively, restore it now. */
6912 restore_search_regs ();
6913 running_asynch_code = outer_running_asynch_code;
6914
6915 Vdeactivate_mark = odeactivate;
6916
6917 /* Restore waiting_for_user_input_p as it was
6918 when we were called, in case the filter clobbered it. */
6919 waiting_for_user_input_p = waiting;
6920
6921 #if 0
6922 if (! EQ (Fcurrent_buffer (), obuffer)
6923 || ! EQ (current_buffer->keymap, okeymap))
6924 #endif
6925 /* But do it only if the caller is actually going to read events.
6926 Otherwise there's no need to make him wake up, and it could
6927 cause trouble (for example it would make sit_for return). */
6928 if (waiting_for_user_input_p == -1)
6929 record_asynch_buffer_change ();
6930
6931 unbind_to (count, Qnil);
6932 }
6933
6934 /* Report all recent events of a change in process status
6935 (either run the sentinel or output a message).
6936 This is usually done while Emacs is waiting for keyboard input
6937 but can be done at other times. */
6938
6939 static void
6940 status_notify (deleting_process)
6941 struct Lisp_Process *deleting_process;
6942 {
6943 register Lisp_Object proc, buffer;
6944 Lisp_Object tail, msg;
6945 struct gcpro gcpro1, gcpro2;
6946
6947 tail = Qnil;
6948 msg = Qnil;
6949 /* We need to gcpro tail; if read_process_output calls a filter
6950 which deletes a process and removes the cons to which tail points
6951 from Vprocess_alist, and then causes a GC, tail is an unprotected
6952 reference. */
6953 GCPRO2 (tail, msg);
6954
6955 /* Set this now, so that if new processes are created by sentinels
6956 that we run, we get called again to handle their status changes. */
6957 update_tick = process_tick;
6958
6959 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
6960 {
6961 Lisp_Object symbol;
6962 register struct Lisp_Process *p;
6963
6964 proc = Fcdr (XCAR (tail));
6965 p = XPROCESS (proc);
6966
6967 if (p->tick != p->update_tick)
6968 {
6969 p->update_tick = p->tick;
6970
6971 /* If process is still active, read any output that remains. */
6972 while (! EQ (p->filter, Qt)
6973 && ! EQ (p->status, Qconnect)
6974 && ! EQ (p->status, Qlisten)
6975 /* Network or serial process not stopped: */
6976 && ! EQ (p->command, Qt)
6977 && p->infd >= 0
6978 && p != deleting_process
6979 && read_process_output (proc, p->infd) > 0);
6980
6981 buffer = p->buffer;
6982
6983 /* Get the text to use for the message. */
6984 if (p->raw_status_new)
6985 update_status (p);
6986 msg = status_message (p);
6987
6988 /* If process is terminated, deactivate it or delete it. */
6989 symbol = p->status;
6990 if (CONSP (p->status))
6991 symbol = XCAR (p->status);
6992
6993 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6994 || EQ (symbol, Qclosed))
6995 {
6996 if (delete_exited_processes)
6997 remove_process (proc);
6998 else
6999 deactivate_process (proc);
7000 }
7001
7002 /* The actions above may have further incremented p->tick.
7003 So set p->update_tick again
7004 so that an error in the sentinel will not cause
7005 this code to be run again. */
7006 p->update_tick = p->tick;
7007 /* Now output the message suitably. */
7008 if (!NILP (p->sentinel))
7009 exec_sentinel (proc, msg);
7010 /* Don't bother with a message in the buffer
7011 when a process becomes runnable. */
7012 else if (!EQ (symbol, Qrun) && !NILP (buffer))
7013 {
7014 Lisp_Object ro, tem;
7015 struct buffer *old = current_buffer;
7016 int opoint, opoint_byte;
7017 int before, before_byte;
7018
7019 ro = XBUFFER (buffer)->read_only;
7020
7021 /* Avoid error if buffer is deleted
7022 (probably that's why the process is dead, too) */
7023 if (NILP (XBUFFER (buffer)->name))
7024 continue;
7025 Fset_buffer (buffer);
7026
7027 opoint = PT;
7028 opoint_byte = PT_BYTE;
7029 /* Insert new output into buffer
7030 at the current end-of-output marker,
7031 thus preserving logical ordering of input and output. */
7032 if (XMARKER (p->mark)->buffer)
7033 Fgoto_char (p->mark);
7034 else
7035 SET_PT_BOTH (ZV, ZV_BYTE);
7036
7037 before = PT;
7038 before_byte = PT_BYTE;
7039
7040 tem = current_buffer->read_only;
7041 current_buffer->read_only = Qnil;
7042 insert_string ("\nProcess ");
7043 Finsert (1, &p->name);
7044 insert_string (" ");
7045 Finsert (1, &msg);
7046 current_buffer->read_only = tem;
7047 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7048
7049 if (opoint >= before)
7050 SET_PT_BOTH (opoint + (PT - before),
7051 opoint_byte + (PT_BYTE - before_byte));
7052 else
7053 SET_PT_BOTH (opoint, opoint_byte);
7054
7055 set_buffer_internal (old);
7056 }
7057 }
7058 } /* end for */
7059
7060 update_mode_lines++; /* in case buffers use %s in mode-line-format */
7061 redisplay_preserve_echo_area (13);
7062
7063 UNGCPRO;
7064 }
7065
7066 \f
7067 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7068 Sset_process_coding_system, 1, 3, 0,
7069 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
7070 DECODING will be used to decode subprocess output and ENCODING to
7071 encode subprocess input. */)
7072 (process, decoding, encoding)
7073 register Lisp_Object process, decoding, encoding;
7074 {
7075 register struct Lisp_Process *p;
7076
7077 CHECK_PROCESS (process);
7078 p = XPROCESS (process);
7079 if (p->infd < 0)
7080 error ("Input file descriptor of %s closed", SDATA (p->name));
7081 if (p->outfd < 0)
7082 error ("Output file descriptor of %s closed", SDATA (p->name));
7083 Fcheck_coding_system (decoding);
7084 Fcheck_coding_system (encoding);
7085 encoding = coding_inherit_eol_type (encoding, Qnil);
7086 p->decode_coding_system = decoding;
7087 p->encode_coding_system = encoding;
7088 setup_process_coding_systems (process);
7089
7090 return Qnil;
7091 }
7092
7093 DEFUN ("process-coding-system",
7094 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7095 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7096 (process)
7097 register Lisp_Object process;
7098 {
7099 CHECK_PROCESS (process);
7100 return Fcons (XPROCESS (process)->decode_coding_system,
7101 XPROCESS (process)->encode_coding_system);
7102 }
7103
7104 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
7105 Sset_process_filter_multibyte, 2, 2, 0,
7106 doc: /* Set multibyteness of the strings given to PROCESS's filter.
7107 If FLAG is non-nil, the filter is given multibyte strings.
7108 If FLAG is nil, the filter is given unibyte strings. In this case,
7109 all character code conversion except for end-of-line conversion is
7110 suppressed. */)
7111 (process, flag)
7112 Lisp_Object process, flag;
7113 {
7114 register struct Lisp_Process *p;
7115
7116 CHECK_PROCESS (process);
7117 p = XPROCESS (process);
7118 if (NILP (flag))
7119 p->decode_coding_system = raw_text_coding_system (p->decode_coding_system);
7120 setup_process_coding_systems (process);
7121
7122 return Qnil;
7123 }
7124
7125 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
7126 Sprocess_filter_multibyte_p, 1, 1, 0,
7127 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7128 (process)
7129 Lisp_Object process;
7130 {
7131 register struct Lisp_Process *p;
7132 struct coding_system *coding;
7133
7134 CHECK_PROCESS (process);
7135 p = XPROCESS (process);
7136 coding = proc_decode_coding_system[p->infd];
7137 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
7138 }
7139
7140
7141 \f
7142 /* Add DESC to the set of keyboard input descriptors. */
7143
7144 void
7145 add_keyboard_wait_descriptor (desc)
7146 int desc;
7147 {
7148 FD_SET (desc, &input_wait_mask);
7149 FD_SET (desc, &non_process_wait_mask);
7150 if (desc > max_keyboard_desc)
7151 max_keyboard_desc = desc;
7152 }
7153
7154 static int add_gpm_wait_descriptor_called_flag;
7155
7156 void
7157 add_gpm_wait_descriptor (desc)
7158 int desc;
7159 {
7160 if (! add_gpm_wait_descriptor_called_flag)
7161 FD_CLR (0, &input_wait_mask);
7162 add_gpm_wait_descriptor_called_flag = 1;
7163 FD_SET (desc, &input_wait_mask);
7164 FD_SET (desc, &gpm_wait_mask);
7165 if (desc > max_gpm_desc)
7166 max_gpm_desc = desc;
7167 }
7168
7169 /* From now on, do not expect DESC to give keyboard input. */
7170
7171 void
7172 delete_keyboard_wait_descriptor (desc)
7173 int desc;
7174 {
7175 int fd;
7176 int lim = max_keyboard_desc;
7177
7178 FD_CLR (desc, &input_wait_mask);
7179 FD_CLR (desc, &non_process_wait_mask);
7180
7181 if (desc == max_keyboard_desc)
7182 for (fd = 0; fd < lim; fd++)
7183 if (FD_ISSET (fd, &input_wait_mask)
7184 && !FD_ISSET (fd, &non_keyboard_wait_mask)
7185 && !FD_ISSET (fd, &gpm_wait_mask))
7186 max_keyboard_desc = fd;
7187 }
7188
7189 void
7190 delete_gpm_wait_descriptor (desc)
7191 int desc;
7192 {
7193 int fd;
7194 int lim = max_gpm_desc;
7195
7196 FD_CLR (desc, &input_wait_mask);
7197 FD_CLR (desc, &non_process_wait_mask);
7198
7199 if (desc == max_gpm_desc)
7200 for (fd = 0; fd < lim; fd++)
7201 if (FD_ISSET (fd, &input_wait_mask)
7202 && !FD_ISSET (fd, &non_keyboard_wait_mask)
7203 && !FD_ISSET (fd, &non_process_wait_mask))
7204 max_gpm_desc = fd;
7205 }
7206
7207 /* Return nonzero if *MASK has a bit set
7208 that corresponds to one of the keyboard input descriptors. */
7209
7210 static int
7211 keyboard_bit_set (mask)
7212 SELECT_TYPE *mask;
7213 {
7214 int fd;
7215
7216 for (fd = 0; fd <= max_keyboard_desc; fd++)
7217 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
7218 && !FD_ISSET (fd, &non_keyboard_wait_mask))
7219 return 1;
7220
7221 return 0;
7222 }
7223 \f
7224 void
7225 init_process ()
7226 {
7227 register int i;
7228
7229 inhibit_sentinels = 0;
7230
7231 #ifdef SIGCHLD
7232 #ifndef CANNOT_DUMP
7233 if (! noninteractive || initialized)
7234 #endif
7235 signal (SIGCHLD, sigchld_handler);
7236 #endif
7237
7238 FD_ZERO (&input_wait_mask);
7239 FD_ZERO (&non_keyboard_wait_mask);
7240 FD_ZERO (&non_process_wait_mask);
7241 max_process_desc = 0;
7242
7243 #ifdef NON_BLOCKING_CONNECT
7244 FD_ZERO (&connect_wait_mask);
7245 num_pending_connects = 0;
7246 #endif
7247
7248 #ifdef ADAPTIVE_READ_BUFFERING
7249 process_output_delay_count = 0;
7250 process_output_skip = 0;
7251 #endif
7252
7253 /* Don't do this, it caused infinite select loops. The display
7254 method should call add_keyboard_wait_descriptor on stdin if it
7255 needs that. */
7256 #if 0
7257 FD_SET (0, &input_wait_mask);
7258 #endif
7259
7260 Vprocess_alist = Qnil;
7261 #ifdef SIGCHLD
7262 deleted_pid_list = Qnil;
7263 #endif
7264 for (i = 0; i < MAXDESC; i++)
7265 {
7266 chan_process[i] = Qnil;
7267 proc_buffered_char[i] = -1;
7268 }
7269 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
7270 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
7271 #ifdef DATAGRAM_SOCKETS
7272 bzero (datagram_address, sizeof datagram_address);
7273 #endif
7274
7275 #ifdef HAVE_SOCKETS
7276 {
7277 Lisp_Object subfeatures = Qnil;
7278 struct socket_options *sopt;
7279
7280 #define ADD_SUBFEATURE(key, val) \
7281 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
7282
7283 #ifdef NON_BLOCKING_CONNECT
7284 ADD_SUBFEATURE (QCnowait, Qt);
7285 #endif
7286 #ifdef DATAGRAM_SOCKETS
7287 ADD_SUBFEATURE (QCtype, Qdatagram);
7288 #endif
7289 #ifdef HAVE_LOCAL_SOCKETS
7290 ADD_SUBFEATURE (QCfamily, Qlocal);
7291 #endif
7292 ADD_SUBFEATURE (QCfamily, Qipv4);
7293 #ifdef AF_INET6
7294 ADD_SUBFEATURE (QCfamily, Qipv6);
7295 #endif
7296 #ifdef HAVE_GETSOCKNAME
7297 ADD_SUBFEATURE (QCservice, Qt);
7298 #endif
7299 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7300 ADD_SUBFEATURE (QCserver, Qt);
7301 #endif
7302
7303 for (sopt = socket_options; sopt->name; sopt++)
7304 subfeatures = Fcons (intern (sopt->name), subfeatures);
7305
7306 Fprovide (intern ("make-network-process"), subfeatures);
7307 }
7308 #endif /* HAVE_SOCKETS */
7309
7310 #if defined (DARWIN) || defined (MAC_OSX)
7311 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7312 processes. As such, we only change the default value. */
7313 if (initialized)
7314 {
7315 char *release = get_operating_system_release();
7316 if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
7317 && release[1] == '.')) {
7318 Vprocess_connection_type = Qnil;
7319 }
7320 }
7321 #endif
7322 }
7323
7324 void
7325 syms_of_process ()
7326 {
7327 Qprocessp = intern ("processp");
7328 staticpro (&Qprocessp);
7329 Qrun = intern ("run");
7330 staticpro (&Qrun);
7331 Qstop = intern ("stop");
7332 staticpro (&Qstop);
7333 Qsignal = intern ("signal");
7334 staticpro (&Qsignal);
7335
7336 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7337 here again.
7338
7339 Qexit = intern ("exit");
7340 staticpro (&Qexit); */
7341
7342 Qopen = intern ("open");
7343 staticpro (&Qopen);
7344 Qclosed = intern ("closed");
7345 staticpro (&Qclosed);
7346 Qconnect = intern ("connect");
7347 staticpro (&Qconnect);
7348 Qfailed = intern ("failed");
7349 staticpro (&Qfailed);
7350 Qlisten = intern ("listen");
7351 staticpro (&Qlisten);
7352 Qlocal = intern ("local");
7353 staticpro (&Qlocal);
7354 Qipv4 = intern ("ipv4");
7355 staticpro (&Qipv4);
7356 #ifdef AF_INET6
7357 Qipv6 = intern ("ipv6");
7358 staticpro (&Qipv6);
7359 #endif
7360 Qdatagram = intern ("datagram");
7361 staticpro (&Qdatagram);
7362
7363 QCport = intern (":port");
7364 staticpro (&QCport);
7365 QCspeed = intern (":speed");
7366 staticpro (&QCspeed);
7367 QCprocess = intern (":process");
7368 staticpro (&QCprocess);
7369
7370 QCbytesize = intern (":bytesize");
7371 staticpro (&QCbytesize);
7372 QCstopbits = intern (":stopbits");
7373 staticpro (&QCstopbits);
7374 QCparity = intern (":parity");
7375 staticpro (&QCparity);
7376 Qodd = intern ("odd");
7377 staticpro (&Qodd);
7378 Qeven = intern ("even");
7379 staticpro (&Qeven);
7380 QCflowcontrol = intern (":flowcontrol");
7381 staticpro (&QCflowcontrol);
7382 Qhw = intern ("hw");
7383 staticpro (&Qhw);
7384 Qsw = intern ("sw");
7385 staticpro (&Qsw);
7386 QCsummary = intern (":summary");
7387 staticpro (&QCsummary);
7388
7389 Qreal = intern ("real");
7390 staticpro (&Qreal);
7391 Qnetwork = intern ("network");
7392 staticpro (&Qnetwork);
7393 Qserial = intern ("serial");
7394 staticpro (&Qserial);
7395
7396 QCname = intern (":name");
7397 staticpro (&QCname);
7398 QCbuffer = intern (":buffer");
7399 staticpro (&QCbuffer);
7400 QChost = intern (":host");
7401 staticpro (&QChost);
7402 QCservice = intern (":service");
7403 staticpro (&QCservice);
7404 QCtype = intern (":type");
7405 staticpro (&QCtype);
7406 QClocal = intern (":local");
7407 staticpro (&QClocal);
7408 QCremote = intern (":remote");
7409 staticpro (&QCremote);
7410 QCcoding = intern (":coding");
7411 staticpro (&QCcoding);
7412 QCserver = intern (":server");
7413 staticpro (&QCserver);
7414 QCnowait = intern (":nowait");
7415 staticpro (&QCnowait);
7416 QCsentinel = intern (":sentinel");
7417 staticpro (&QCsentinel);
7418 QClog = intern (":log");
7419 staticpro (&QClog);
7420 QCnoquery = intern (":noquery");
7421 staticpro (&QCnoquery);
7422 QCstop = intern (":stop");
7423 staticpro (&QCstop);
7424 QCoptions = intern (":options");
7425 staticpro (&QCoptions);
7426 QCplist = intern (":plist");
7427 staticpro (&QCplist);
7428
7429 Qlast_nonmenu_event = intern ("last-nonmenu-event");
7430 staticpro (&Qlast_nonmenu_event);
7431
7432 staticpro (&Vprocess_alist);
7433 #ifdef SIGCHLD
7434 staticpro (&deleted_pid_list);
7435 #endif
7436
7437 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
7438 doc: /* *Non-nil means delete processes immediately when they exit.
7439 A value of nil means don't delete them until `list-processes' is run. */);
7440
7441 delete_exited_processes = 1;
7442
7443 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
7444 doc: /* Control type of device used to communicate with subprocesses.
7445 Values are nil to use a pipe, or t or `pty' to use a pty.
7446 The value has no effect if the system has no ptys or if all ptys are busy:
7447 then a pipe is used in any case.
7448 The value takes effect when `start-process' is called. */);
7449 Vprocess_connection_type = Qt;
7450
7451 #ifdef ADAPTIVE_READ_BUFFERING
7452 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering,
7453 doc: /* If non-nil, improve receive buffering by delaying after short reads.
7454 On some systems, when Emacs reads the output from a subprocess, the output data
7455 is read in very small blocks, potentially resulting in very poor performance.
7456 This behavior can be remedied to some extent by setting this variable to a
7457 non-nil value, as it will automatically delay reading from such processes, to
7458 allow them to produce more output before Emacs tries to read it.
7459 If the value is t, the delay is reset after each write to the process; any other
7460 non-nil value means that the delay is not reset on write.
7461 The variable takes effect when `start-process' is called. */);
7462 Vprocess_adaptive_read_buffering = Qt;
7463 #endif
7464
7465 defsubr (&Sprocessp);
7466 defsubr (&Sget_process);
7467 defsubr (&Sget_buffer_process);
7468 defsubr (&Sdelete_process);
7469 defsubr (&Sprocess_status);
7470 defsubr (&Sprocess_exit_status);
7471 defsubr (&Sprocess_id);
7472 defsubr (&Sprocess_name);
7473 defsubr (&Sprocess_tty_name);
7474 defsubr (&Sprocess_command);
7475 defsubr (&Sset_process_buffer);
7476 defsubr (&Sprocess_buffer);
7477 defsubr (&Sprocess_mark);
7478 defsubr (&Sset_process_filter);
7479 defsubr (&Sprocess_filter);
7480 defsubr (&Sset_process_sentinel);
7481 defsubr (&Sprocess_sentinel);
7482 defsubr (&Sset_process_window_size);
7483 defsubr (&Sset_process_inherit_coding_system_flag);
7484 defsubr (&Sprocess_inherit_coding_system_flag);
7485 defsubr (&Sset_process_query_on_exit_flag);
7486 defsubr (&Sprocess_query_on_exit_flag);
7487 defsubr (&Sprocess_contact);
7488 defsubr (&Sprocess_plist);
7489 defsubr (&Sset_process_plist);
7490 defsubr (&Slist_processes);
7491 defsubr (&Sprocess_list);
7492 defsubr (&Sstart_process);
7493 #ifdef HAVE_SERIAL
7494 defsubr (&Sserial_process_configure);
7495 defsubr (&Smake_serial_process);
7496 #endif /* HAVE_SERIAL */
7497 #ifdef HAVE_SOCKETS
7498 defsubr (&Sset_network_process_option);
7499 defsubr (&Smake_network_process);
7500 defsubr (&Sformat_network_address);
7501 #endif /* HAVE_SOCKETS */
7502 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7503 #ifdef SIOCGIFCONF
7504 defsubr (&Snetwork_interface_list);
7505 #endif
7506 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7507 defsubr (&Snetwork_interface_info);
7508 #endif
7509 #endif /* HAVE_SOCKETS ... */
7510 #ifdef DATAGRAM_SOCKETS
7511 defsubr (&Sprocess_datagram_address);
7512 defsubr (&Sset_process_datagram_address);
7513 #endif
7514 defsubr (&Saccept_process_output);
7515 defsubr (&Sprocess_send_region);
7516 defsubr (&Sprocess_send_string);
7517 defsubr (&Sinterrupt_process);
7518 defsubr (&Skill_process);
7519 defsubr (&Squit_process);
7520 defsubr (&Sstop_process);
7521 defsubr (&Scontinue_process);
7522 defsubr (&Sprocess_running_child_p);
7523 defsubr (&Sprocess_send_eof);
7524 defsubr (&Ssignal_process);
7525 defsubr (&Swaiting_for_user_input_p);
7526 defsubr (&Sprocess_type);
7527 defsubr (&Sset_process_coding_system);
7528 defsubr (&Sprocess_coding_system);
7529 defsubr (&Sset_process_filter_multibyte);
7530 defsubr (&Sprocess_filter_multibyte_p);
7531 }
7532
7533 \f
7534 #else /* not subprocesses */
7535
7536 #include <sys/types.h>
7537 #include <errno.h>
7538
7539 #include "lisp.h"
7540 #include "systime.h"
7541 #include "character.h"
7542 #include "coding.h"
7543 #include "termopts.h"
7544 #include "sysselect.h"
7545
7546 extern int frame_garbaged;
7547
7548 extern EMACS_TIME timer_check ();
7549 extern int timers_run;
7550
7551 Lisp_Object QCtype;
7552
7553 /* As described above, except assuming that there are no subprocesses:
7554
7555 Wait for timeout to elapse and/or keyboard input to be available.
7556
7557 time_limit is:
7558 timeout in seconds, or
7559 zero for no limit, or
7560 -1 means gobble data immediately available but don't wait for any.
7561
7562 read_kbd is a Lisp_Object:
7563 0 to ignore keyboard input, or
7564 1 to return when input is available, or
7565 -1 means caller will actually read the input, so don't throw to
7566 the quit handler.
7567
7568 see full version for other parameters. We know that wait_proc will
7569 always be NULL, since `subprocesses' isn't defined.
7570
7571 do_display != 0 means redisplay should be done to show subprocess
7572 output that arrives.
7573
7574 Return true if we received input from any process. */
7575
7576 int
7577 wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
7578 wait_for_cell, wait_proc, just_wait_proc)
7579 int time_limit, microsecs, read_kbd, do_display;
7580 Lisp_Object wait_for_cell;
7581 struct Lisp_Process *wait_proc;
7582 int just_wait_proc;
7583 {
7584 register int nfds;
7585 EMACS_TIME end_time, timeout;
7586 SELECT_TYPE waitchannels;
7587 int xerrno;
7588
7589 /* What does time_limit really mean? */
7590 if (time_limit || microsecs)
7591 {
7592 EMACS_GET_TIME (end_time);
7593 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
7594 EMACS_ADD_TIME (end_time, end_time, timeout);
7595 }
7596
7597 /* Turn off periodic alarms (in case they are in use)
7598 and then turn off any other atimers,
7599 because the select emulator uses alarms. */
7600 stop_polling ();
7601 turn_on_atimers (0);
7602
7603 while (1)
7604 {
7605 int timeout_reduced_for_timers = 0;
7606
7607 /* If calling from keyboard input, do not quit
7608 since we want to return C-g as an input character.
7609 Otherwise, do pending quit if requested. */
7610 if (read_kbd >= 0)
7611 QUIT;
7612
7613 /* Exit now if the cell we're waiting for became non-nil. */
7614 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7615 break;
7616
7617 /* Compute time from now till when time limit is up */
7618 /* Exit if already run out */
7619 if (time_limit == -1)
7620 {
7621 /* -1 specified for timeout means
7622 gobble output available now
7623 but don't wait at all. */
7624
7625 EMACS_SET_SECS_USECS (timeout, 0, 0);
7626 }
7627 else if (time_limit || microsecs)
7628 {
7629 EMACS_GET_TIME (timeout);
7630 EMACS_SUB_TIME (timeout, end_time, timeout);
7631 if (EMACS_TIME_NEG_P (timeout))
7632 break;
7633 }
7634 else
7635 {
7636 EMACS_SET_SECS_USECS (timeout, 100000, 0);
7637 }
7638
7639 /* If our caller will not immediately handle keyboard events,
7640 run timer events directly.
7641 (Callers that will immediately read keyboard events
7642 call timer_delay on their own.) */
7643 if (NILP (wait_for_cell))
7644 {
7645 EMACS_TIME timer_delay;
7646
7647 do
7648 {
7649 int old_timers_run = timers_run;
7650 timer_delay = timer_check (1);
7651 if (timers_run != old_timers_run && do_display)
7652 /* We must retry, since a timer may have requeued itself
7653 and that could alter the time delay. */
7654 redisplay_preserve_echo_area (14);
7655 else
7656 break;
7657 }
7658 while (!detect_input_pending ());
7659
7660 /* If there is unread keyboard input, also return. */
7661 if (read_kbd != 0
7662 && requeued_events_pending_p ())
7663 break;
7664
7665 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
7666 {
7667 EMACS_TIME difference;
7668 EMACS_SUB_TIME (difference, timer_delay, timeout);
7669 if (EMACS_TIME_NEG_P (difference))
7670 {
7671 timeout = timer_delay;
7672 timeout_reduced_for_timers = 1;
7673 }
7674 }
7675 }
7676
7677 /* Cause C-g and alarm signals to take immediate action,
7678 and cause input available signals to zero out timeout. */
7679 if (read_kbd < 0)
7680 set_waiting_for_input (&timeout);
7681
7682 /* Wait till there is something to do. */
7683
7684 if (! read_kbd && NILP (wait_for_cell))
7685 FD_ZERO (&waitchannels);
7686 else
7687 FD_SET (0, &waitchannels);
7688
7689 /* If a frame has been newly mapped and needs updating,
7690 reprocess its display stuff. */
7691 if (frame_garbaged && do_display)
7692 {
7693 clear_waiting_for_input ();
7694 redisplay_preserve_echo_area (15);
7695 if (read_kbd < 0)
7696 set_waiting_for_input (&timeout);
7697 }
7698
7699 if (read_kbd && detect_input_pending ())
7700 {
7701 nfds = 0;
7702 FD_ZERO (&waitchannels);
7703 }
7704 else
7705 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
7706 &timeout);
7707
7708 xerrno = errno;
7709
7710 /* Make C-g and alarm signals set flags again */
7711 clear_waiting_for_input ();
7712
7713 /* If we woke up due to SIGWINCH, actually change size now. */
7714 do_pending_window_change (0);
7715
7716 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
7717 /* We waited the full specified time, so return now. */
7718 break;
7719
7720 if (nfds == -1)
7721 {
7722 /* If the system call was interrupted, then go around the
7723 loop again. */
7724 if (xerrno == EINTR)
7725 FD_ZERO (&waitchannels);
7726 else
7727 error ("select error: %s", emacs_strerror (xerrno));
7728 }
7729 #ifdef sun
7730 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
7731 /* System sometimes fails to deliver SIGIO. */
7732 kill (getpid (), SIGIO);
7733 #endif
7734 #ifdef SIGIO
7735 if (read_kbd && interrupt_input && (waitchannels & 1))
7736 kill (getpid (), SIGIO);
7737 #endif
7738
7739 /* Check for keyboard input */
7740
7741 if (read_kbd
7742 && detect_input_pending_run_timers (do_display))
7743 {
7744 swallow_events (do_display);
7745 if (detect_input_pending_run_timers (do_display))
7746 break;
7747 }
7748
7749 /* If there is unread keyboard input, also return. */
7750 if (read_kbd
7751 && requeued_events_pending_p ())
7752 break;
7753
7754 /* If wait_for_cell. check for keyboard input
7755 but don't run any timers.
7756 ??? (It seems wrong to me to check for keyboard
7757 input at all when wait_for_cell, but the code
7758 has been this way since July 1994.
7759 Try changing this after version 19.31.) */
7760 if (! NILP (wait_for_cell)
7761 && detect_input_pending ())
7762 {
7763 swallow_events (do_display);
7764 if (detect_input_pending ())
7765 break;
7766 }
7767
7768 /* Exit now if the cell we're waiting for became non-nil. */
7769 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7770 break;
7771 }
7772
7773 start_polling ();
7774
7775 return 0;
7776 }
7777
7778
7779 /* Don't confuse make-docfile by having two doc strings for this function.
7780 make-docfile does not pay attention to #if, for good reason! */
7781 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7782 0)
7783 (name)
7784 register Lisp_Object name;
7785 {
7786 return Qnil;
7787 }
7788
7789 /* Don't confuse make-docfile by having two doc strings for this function.
7790 make-docfile does not pay attention to #if, for good reason! */
7791 DEFUN ("process-inherit-coding-system-flag",
7792 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7793 1, 1, 0,
7794 0)
7795 (process)
7796 register Lisp_Object process;
7797 {
7798 /* Ignore the argument and return the value of
7799 inherit-process-coding-system. */
7800 return inherit_process_coding_system ? Qt : Qnil;
7801 }
7802
7803 /* Kill all processes associated with `buffer'.
7804 If `buffer' is nil, kill all processes.
7805 Since we have no subprocesses, this does nothing. */
7806
7807 void
7808 kill_buffer_processes (buffer)
7809 Lisp_Object buffer;
7810 {
7811 }
7812
7813 void
7814 init_process ()
7815 {
7816 }
7817
7818 void
7819 syms_of_process ()
7820 {
7821 QCtype = intern (":type");
7822 staticpro (&QCtype);
7823
7824 defsubr (&Sget_buffer_process);
7825 defsubr (&Sprocess_inherit_coding_system_flag);
7826 }
7827
7828 \f
7829 #endif /* not subprocesses */
7830
7831 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7832 (do not change this comment) */