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