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