1 /* unix_processes.c -- Subprocess handling for Unix
2    Copyright (C) 1993, 1994 John Harper <john@dcs.warwick.ac.uk>
3    $Id$
4 
5    This file is part of Jade.
6 
7    Jade is free software; you can redistribute it and/or modify it
8    under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 2, or (at your option)
10    any later version.
11 
12    Jade is distributed in the hope that it will be useful, but
13    WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with Jade; see the file COPYING.	If not, write to
19    the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
20 
21 #define _GNU_SOURCE
22 
23 #include "repint.h"
24 
25 /* Note that I have no idea how portable this code will be. It has
26    been tested under Solaris and Linux, but beyond that, I really don't
27    have the experience... */
28 
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <string.h>
32 #include <assert.h>
33 #include <signal.h>
34 #include <errno.h>
35 #include <sys/types.h>
36 #include <sys/stat.h>
37 #include <sys/socket.h>
38 
39 #ifdef NEED_MEMORY_H
40 # include <memory.h>
41 #endif
42 
43 #ifdef HAVE_UNISTD_H
44 # include <unistd.h>
45 #endif
46 
47 #ifdef HAVE_FCNTL_H
48 # include <fcntl.h>
49 #else
50 # include <sys/fcntl.h>
51 #endif
52 
53 #ifdef HAVE_SYS_TIME_H
54 # include <sys/time.h>
55 #endif
56 
57 #if HAVE_SYS_WAIT_H
58 # include <sys/wait.h>
59 #endif
60 #ifndef WEXITSTATUS
61 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
62 #endif
63 #ifndef WIFEXITED
64 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
65 #endif
66 
67 #ifdef HAVE_SYS_IOCTL_H
68 # include <sys/ioctl.h>
69 #endif
70 
71 #ifdef HAVE_TERMIOS_H
72 # include <termios.h>
73 #endif
74 
75 #ifdef HAVE_DEV_PTMX
76 # ifdef HAVE_STROPTS_H
77 #  include <stropts.h>
78 # endif
79 #endif
80 
81 #ifdef ENVIRON_UNDECLARED
82   extern char **environ;
83 #endif
84 
85 void (*rep_sigchld_fun) (void) = 0;
86 
87 static struct sigaction chld_sigact;
88 static sigset_t chld_sigset;
89 
90 struct Proc
91 {
92     repv	pr_Car;		/* status in high bits */
93     struct Proc *pr_Next;
94     /* Chain of all processes waiting to be notified of a change of state. */
95     struct Proc *pr_NotifyNext;
96     pid_t	pr_Pid;
97     /* pr_Stdin is where we write, pr_Stdout where we read, they may be the
98        same.  pr_Stderr is only used with pipes--it may be a separate
99        connection to the stderr stream of the process. At all other times
100        it will be equal to pr_Stdout. */
101     int		pr_Stdin, pr_Stdout, pr_Stderr;
102     repv	pr_OutputStream, pr_ErrorStream;
103     int		pr_ExitStatus;
104     repv	pr_NotifyFun;
105     repv	pr_Prog;
106     repv	pr_Args;
107     repv	pr_Dir;
108     repv	pr_ConnType;
109 };
110 
111 /* Status is two bits above the type code (presently 8->9) */
112 #define PR_ACTIVE  (1 << (rep_CELL16_TYPE_BITS + 0))	/* active, may be stopped */
113 #define PR_STOPPED (2 << (rep_CELL16_TYPE_BITS + 1))	/* stopped */
114 #define PR_DEAD    0
115 #define PR_RUNNING PR_ACTIVE
116 
117 #define PR_ACTIVE_P(p)  ((p)->pr_Car & PR_ACTIVE)
118 #define PR_STOPPED_P(p) ((p)->pr_Car & PR_STOPPED)
119 #define PR_RUNNING_P(p) (PR_ACTIVE_P(p) && !PR_STOPPED_P(p))
120 #define PR_DEAD_P(p)    !PR_ACTIVE_P(p)
121 
122 #define PR_SET_STATUS(p,s) \
123     ((p)->pr_Car = (((p)->pr_Car & ~(PR_ACTIVE | PR_STOPPED)) | (s)))
124 
125 /* Connection types */
126 DEFSYM(pipe, "pipe");
127 DEFSYM(pty, "pty");
128 DEFSYM(socketpair, "socketpair");
129 
130 #define PR_CONN_PTY_P(p) \
131     ((p)->pr_ConnType == Qpty)
132 
133 #define PR_CONN_PIPE_P(p) \
134     ((p)->pr_ConnType == Qpipe)
135 
136 #define PR_CONN_SOCKETPAIR_P(p) \
137     ((p)->pr_ConnType == Qsocketpair)
138 
139 #define VPROC(v)	((struct Proc *)rep_PTR(v))
140 #define PROCESSP(v)	rep_CELL16_TYPEP(v, process_type)
141 
142 /* Handy debugging macro */
143 #if 0
144 # define DB(x) fprintf x
145 #else
146 # define DB(x)
147 #endif
148 
149 static struct Proc *process_chain;
150 static struct Proc *notify_chain;
151 static int process_run_count;
152 
153 static int process_type;
154 
155 /* Set to rep_TRUE by the SIGCHLD handler */
156 static volatile rep_bool got_sigchld;
157 
158 static void read_from_one_fd(struct Proc *pr, int fd);
159 static void read_from_process(int);
160 
161 DEFSTRING(not_running, "Not running");
162 DEFSTRING(not_stopped, "Not stopped");
163 DEFSTRING(no_link, "No link to input");
164 DEFSTRING(in_use, "Process in use");
165 DEFSTRING(no_pty, "Can't find unused pty");
166 DEFSTRING(already_running, "Already running");
167 DEFSTRING(no_prog, "No program");
168 DEFSTRING(cant_start, "Can't start");
169 DEFSTRING(dev_null, "/dev/null");
170 DEFSTRING(dot, ".");
171 DEFSTRING(not_local, "Need a local file");
172 DEFSTRING(forkstr, "fork");
173 DEFSTRING(nosig, "Unknown signal");
174 
175 
176 
177 static RETSIGTYPE
sigchld_handler(int sig)178 sigchld_handler(int sig)
179 {
180     got_sigchld = rep_TRUE;
181     if (rep_sigchld_fun != 0)
182 	(*rep_sigchld_fun) ();
183 }
184 
185 static void
close_proc_files(struct Proc * pr)186 close_proc_files(struct Proc *pr)
187 {
188     if(pr->pr_Stdout)
189     {
190 	rep_deregister_input_fd(pr->pr_Stdout);
191 	close(pr->pr_Stdout);
192     }
193     if(pr->pr_Stderr && pr->pr_Stderr != pr->pr_Stdout)
194     {
195 	rep_deregister_input_fd(pr->pr_Stderr);
196 	close(pr->pr_Stderr);
197     }
198     if(pr->pr_Stdin && (pr->pr_Stdin != pr->pr_Stdout))
199 	close(pr->pr_Stdin);
200     pr->pr_Stdout = pr->pr_Stdin = pr->pr_Stderr = 0;
201 }
202 
203 /* PR's NotifyFun will be called when possible. This function is safe
204    to call from signal handlers.  */
205 static void
queue_notify(struct Proc * pr)206 queue_notify(struct Proc *pr)
207 {
208     if(pr->pr_NotifyNext == NULL)
209     {
210 	pr->pr_NotifyNext = notify_chain;
211 	notify_chain = pr;
212     }
213 }
214 
215 /* Dispatch all queued notification.  */
216 static rep_bool
proc_notification(void)217 proc_notification(void)
218 {
219     if(!notify_chain)
220 	return(rep_FALSE);
221     while(notify_chain != NULL && !rep_INTERRUPTP)
222     {
223 	struct Proc *pr = notify_chain;
224 	notify_chain = pr->pr_NotifyNext;
225 	pr->pr_NotifyNext = NULL;
226 	if(pr->pr_NotifyFun && !rep_NILP(pr->pr_NotifyFun))
227 	    rep_call_lisp1(pr->pr_NotifyFun, rep_VAL(pr));
228     }
229     return rep_TRUE;
230 }
231 
232 static inline rep_bool
notify_queued_p(struct Proc * pr)233 notify_queued_p (struct Proc *pr)
234 {
235     return pr->pr_NotifyNext != 0;
236 }
237 
238 static void
notify_1(struct Proc * pr)239 notify_1 (struct Proc *pr)
240 {
241     if (notify_queued_p (pr))
242     {
243 	struct Proc **ptr = &notify_chain;
244 	while (*ptr != pr)
245 	    ptr = &((*ptr)->pr_NotifyNext);
246 	*ptr = pr->pr_NotifyNext;
247 	pr->pr_NotifyNext = NULL;
248 	if (pr->pr_NotifyFun && pr->pr_NotifyFun != Qnil)
249 	    rep_call_lisp1 (pr->pr_NotifyFun, rep_VAL (pr));
250     }
251 }
252 
253 /* Checks if any of my children are zombies, takes appropriate action. */
254 static rep_bool
check_for_zombies(void)255 check_for_zombies(void)
256 {
257     if(!got_sigchld)
258 	return rep_FALSE;
259 
260     got_sigchld = rep_FALSE;
261     while(process_run_count > 0)
262     {
263 	struct Proc *pr;
264 	int status;
265 	pid_t pid;
266 
267 	pid = waitpid(-1, &status, WNOHANG | WUNTRACED);
268 	if(pid > 0)
269 	{
270 	    /* Got a process id, find its process structure. */
271 	    for(pr = process_chain; pr != 0; pr = pr->pr_Next)
272 	    {
273 		if(PR_ACTIVE_P(pr) && (pr->pr_Pid == pid))
274 		{
275 		    /* Got it. */
276 #ifdef WIFSTOPPED
277 		    if(WIFSTOPPED(status))
278 		    {
279 			/* Process is suspended. */
280 			PR_SET_STATUS(pr, PR_ACTIVE | PR_STOPPED);
281 			queue_notify(pr);
282 		    }
283 		    else
284 #endif
285 		    {
286 			/* Process is dead. */
287 			pr->pr_ExitStatus = status;
288 			process_run_count--;
289 			PR_SET_STATUS(pr, PR_DEAD);
290 
291 			/* Try to read any pending output */
292 			if(pr->pr_Stdout)
293 			    read_from_one_fd(pr, pr->pr_Stdout);
294 			if(pr->pr_Stderr && pr->pr_Stderr != pr->pr_Stdout)
295 			    read_from_one_fd(pr, pr->pr_Stderr);
296 
297 			/* Then close the streams */
298 			close_proc_files(pr);
299 
300 			queue_notify(pr);
301 		    }
302 		    break;
303 		}
304 	    }
305 	}
306 	else if(pid == 0)
307 	    break;
308 	else if(pid < 0)
309 	{
310 	    if(errno == EINTR)
311 		continue;
312 	    else
313 		break;
314 	}
315     }
316     return rep_TRUE;
317 }
318 
319 /* Called by the event loop after each event or timeout. Returns true
320    if the display should be updated. */
321 static rep_bool
proc_periodically(void)322 proc_periodically(void)
323 {
324     rep_bool rc = check_for_zombies();
325     if(proc_notification())
326 	rc = rep_TRUE;
327     return rc;
328 }
329 
330 /* Read data from FD out of PROC. If necessary it will handle
331    clean up and notification. */
332 static void
read_from_one_fd(struct Proc * pr,int fd)333 read_from_one_fd(struct Proc *pr, int fd)
334 {
335     repv stream = ((fd != pr->pr_Stdout)
336 		    ? pr->pr_ErrorStream : pr->pr_OutputStream);
337     char buf[1025];
338     int actual;
339     do {
340 	if((actual = read(fd, buf, 1024)) > 0)
341 	{
342 	    buf[actual] = 0;
343 	    if(!rep_NILP(stream))
344 		rep_stream_puts(stream, buf, actual, rep_FALSE);
345 	}
346     } while((actual > 0) || (actual < 0 && errno == EINTR));
347 
348     if (actual == 0 || (actual < 0 && errno != EWOULDBLOCK && errno != EAGAIN))
349     {
350 	/* We assume EOF  */
351 
352 	rep_deregister_input_fd(fd);
353 	close(fd);
354 
355 	/* Could be either pr_Stdout or pr_Stderr */
356 	if(fd != pr->pr_Stdout)
357 	    pr->pr_Stderr = 0;
358 	else
359 	{
360 	    if(pr->pr_Stdin && (pr->pr_Stdin == pr->pr_Stdout))
361 		pr->pr_Stdin = 0;
362 	    if(pr->pr_Stderr && (pr->pr_Stderr == pr->pr_Stdout))
363 		pr->pr_Stderr = 0;
364 	    pr->pr_Stdout = 0;
365 	}
366     }
367 }
368 
369 static void
read_from_process(int fd)370 read_from_process(int fd)
371 {
372     struct Proc *pr;
373     pr = process_chain;
374     while(pr)
375     {
376 	if(PR_ACTIVE_P(pr) && (pr->pr_Stdout == fd || pr->pr_Stderr == fd))
377 	    read_from_one_fd(pr, fd);
378 	pr = pr->pr_Next;
379     }
380 }
381 
382 static int
write_to_process(repv pr,char * buf,int bufLen)383 write_to_process(repv pr, char *buf, int bufLen)
384 {
385     int act = 0;
386     if(!PROCESSP(pr))
387 	return(0);
388     if(PR_ACTIVE_P(VPROC(pr)))
389     {
390 	if(VPROC(pr)->pr_Stdin == 0)
391 	{
392 	    Fsignal(Qprocess_error, rep_list_2(pr, rep_VAL(&no_link)));
393 	}
394 	else
395 	{
396 	    do {
397 		/* This will block */
398 		int this = write(VPROC(pr)->pr_Stdin, buf + act, bufLen - act);
399 		if (this < 0)
400 		{
401 		    if (errno != EINTR)
402 		    {
403 			rep_signal_file_error(pr);
404 			break;
405 		    }
406 		}
407 		else
408 		    act += this;
409 	    } while (act < bufLen);
410 	}
411     }
412     else
413 	Fsignal(Qprocess_error, rep_list_2(pr, rep_VAL(&not_running)));
414     return(act);
415 }
416 
417 static rep_bool
signal_process(struct Proc * pr,int sig,rep_bool do_grp)418 signal_process(struct Proc *pr, int sig, rep_bool do_grp)
419 {
420     rep_bool rc = rep_TRUE;
421     if(do_grp)
422     {
423 	if(pr->pr_Stdin && PR_CONN_PTY_P(pr))
424 	{
425 	    pid_t gid = tcgetpgrp(pr->pr_Stdin);
426 	    if(gid != -1)
427 		kill(-gid, sig);
428 	    else if(PR_ACTIVE_P(pr))
429 		kill(-pr->pr_Pid, sig);
430 	    else
431 		rc = rep_FALSE;
432 	}
433 	else
434 	{
435 	    if(PR_ACTIVE_P(pr))
436 		kill(-pr->pr_Pid, sig);
437 	    else
438 		rc = rep_FALSE;
439 	}
440     }
441     else
442     {
443 	if(PR_ACTIVE_P(pr))
444 	    kill(pr->pr_Pid, sig);
445 	else
446 	    rc = rep_FALSE;
447     }
448     return(rc);
449 }
450 
451 /* This is only called during GC, when the process isn't being referenced.
452    it will already have been taken out of the chain. Also active processes
453    should have been marked anyway. */
454 static void
kill_process(struct Proc * pr)455 kill_process(struct Proc *pr)
456 {
457     if(PR_ACTIVE_P(pr))
458     {
459 	/* is this too heavy-handed?? */
460 	if(!signal_process(pr, SIGKILL, rep_TRUE))
461 	    kill(-pr->pr_Pid, SIGKILL);
462 	waitpid(pr->pr_Pid, &pr->pr_ExitStatus, 0);
463 	process_run_count--;
464 	close_proc_files(pr);
465     }
466     rep_FREE_CELL(pr);
467 }
468 
469 /* Return the file descriptor (or 0 if an error) of the first available
470    pty master. SLAVENAM will contain the name of the associated slave. */
471 static int
get_pty(char * slavenam)472 get_pty(char *slavenam)
473 {
474 #if defined(HAVE_PTYS)
475     int master;
476 
477 # if defined(HAVE_DEV_PTMX) && defined(HAVE_GRANTPT)
478     master = open("/dev/ptmx", O_RDWR);
479     if(master >= 0)
480     {
481 	char *tem;
482 	grantpt(master);
483 	unlockpt(master);
484 	tem = ptsname(master);
485 	if(tem != 0)
486 	{
487 	    strcpy(slavenam, tem);
488 	    return master;
489 	}
490 	close(master);
491     }
492 # endif
493 
494 # if defined(FIRST_PTY_LETTER)
495     /* Assume /dev/ptyXNN and /dev/ttyXN naming system.
496        The FIRST_PTY_LETTER gives the first X to try. We try in the
497        sequence FIRST_PTY_LETTER, .., 'z', 'a', .., FIRST_PTY_LETTER.
498        Is this worthwhile, or just over-zealous? */
499     char c = FIRST_PTY_LETTER;
500     do {
501 	int i;
502 	for(i = 0; i < 16; i++)
503 	{
504 	    struct stat statb;
505 	    sprintf(slavenam, "/dev/pty%c%x", c, i);
506 	    if(stat(slavenam, &statb) < 0)
507 		goto none;
508 	    if((master = open(slavenam, O_RDWR)) >= 0)
509 	    {
510 		slavenam[sizeof("/dev/")-1] = 't';
511 		if(access(slavenam, R_OK | W_OK) == 0)
512 		    return master;
513 		close(master);
514 	    }
515 	}
516 	if(++c > 'z')
517 	    c = 'a';
518     } while(c != FIRST_PTY_LETTER);
519 none:
520 # endif /* FIRST_PTY_LETTER */
521 #endif /* HAVE_PTYS */
522 
523     /* Couldn't find a pty. Signal an error. */
524     Fsignal(Qprocess_error, rep_LIST_1(rep_VAL(&no_pty)));
525     return 0;
526 }
527 
528 static void
child_build_environ(void)529 child_build_environ (void)
530 {
531     /* Build the environment */
532     repv tem = Fsymbol_value(Qprocess_environment, Qt);
533     if(rep_CONSP(tem))
534     {
535 	repv len = Flength(tem);
536 	if(len && rep_INTP(len))
537 	{
538 	    environ = rep_alloc(sizeof(char *) * (rep_INT(len) + 1));
539 	    if(environ != 0)
540 	    {
541 		char **ptr = environ;
542 		while(rep_CONSP(tem))
543 		{
544 		    *ptr++ = rep_STR(rep_CAR(tem));
545 		    tem = rep_CDR(tem);
546 		}
547 		*ptr++ = 0;
548 	    }
549 	}
550     }
551 }
552 
553 /* does the dirty stuff of getting the process running. if SYNC_INPUT
554    is non-NULL it means to run the process synchronously with it's
555    stdin connected to the file SYNC_INPUT. Otherwise this function returns
556    immediately after starting the process.  */
557 static rep_bool
run_process(struct Proc * pr,char ** argv,char * sync_input)558 run_process(struct Proc *pr, char **argv, char *sync_input)
559 {
560     rep_bool rc = rep_FALSE;
561     if(PR_DEAD_P(pr))
562     {
563 	rep_bool usepty = PR_CONN_PTY_P(pr);
564 	char slavenam[32];
565 	int stdin_fds[2], stdout_fds[2], stderr_fds[2]; /* only for pipes */
566 	pr->pr_ExitStatus = -1;
567 
568 	if(sync_input != NULL || !usepty)
569 	{
570 	    usepty = rep_FALSE;
571 	    pr->pr_ConnType = Qpipe;
572 	    if(pipe(stdout_fds) == 0)
573 	    {
574 		if(pipe(stderr_fds) == 0)
575 		{
576 		    if(sync_input)
577 		    {
578 			stdin_fds[0] = open(sync_input, O_RDONLY);
579 			if(stdin_fds[0] >= 0)
580 			    pr->pr_Stdin = stdin_fds[0]; /* fake */
581 		    }
582 		    else
583 		    {
584 			if(pipe(stdin_fds) == 0)
585 			    pr->pr_Stdin = stdin_fds[1];
586 		    }
587 		    if(pr->pr_Stdin != 0)
588 		    {
589 			pr->pr_Stdout = stdout_fds[0];
590 			pr->pr_Stderr = stderr_fds[0];
591 		    }
592 		    else
593 		    {
594 			close(stderr_fds[0]);
595 			close(stderr_fds[1]);
596 		    }
597 		}
598 		else
599 		{
600 		    close(stdout_fds[0]);
601 		    close(stdout_fds[1]);
602 		}
603 	    }
604 	}
605 	else if (PR_CONN_SOCKETPAIR_P(pr))
606 	{
607 	    /* XXX separate stdout from stderr.. */
608 	    if (socketpair (AF_UNIX, SOCK_STREAM, 0, stdin_fds) == 0)
609 	    {
610 		pr->pr_Stdin = stdin_fds[0];
611 		pr->pr_Stdout = stdin_fds[0];
612 		pr->pr_Stderr = stdin_fds[0];
613 	    }
614 	}
615 	else if(usepty)
616 	{
617 	    pr->pr_Stdin = get_pty(slavenam);
618 	    pr->pr_Stdout = pr->pr_Stdin;
619 	    pr->pr_Stderr = pr->pr_Stdin;
620 	}
621 	if(pr->pr_Stdin)
622 	{
623 	    int pty_slave_fd = -1;
624 
625 	    /* Must set up pty slave before forking, to avoid race
626 	       condition if master writes to it first */
627 	    if(usepty)
628 	    {
629 		struct termios st;
630 		pty_slave_fd = open(slavenam, O_RDWR);
631 		if (pty_slave_fd >= 0)
632 		{
633 #ifdef HAVE_DEV_PTMX
634 # ifdef I_PUSH
635 		    /* Push the necessary modules onto the slave to
636 		       get terminal semantics. */
637 		    ioctl(pty_slave_fd, I_PUSH, "ptem");
638 		    ioctl(pty_slave_fd, I_PUSH, "ldterm");
639 # endif
640 #endif
641 #ifdef TIOCSCTTY
642 		    ioctl(pty_slave_fd, TIOCSCTTY, 0);
643 #endif
644 		    tcgetattr(pty_slave_fd, &st);
645 		    st.c_iflag &= ~(ISTRIP | IGNCR | INLCR | IXOFF);
646 		    st.c_iflag |= (ICRNL | IGNPAR | BRKINT | IXON);
647 		    st.c_oflag &= ~OPOST;
648 		    st.c_cflag &= ~CSIZE;
649 		    st.c_cflag |= CREAD | CS8 | CLOCAL;
650 		    st.c_lflag &= ~(ECHO | ECHOE | ECHOK | NOFLSH | TOSTOP);
651 		    st.c_lflag |= ISIG;
652 #if 0
653 		    st.c_cc[VMIN] = 1;
654 		    st.c_cc[VTIME] = 0;
655 #endif
656 		    /* Set some control codes to default values */
657 		    st.c_cc[VINTR]  = '\003';	/* ^c */
658 		    st.c_cc[VQUIT]  = '\034';	/* ^| */
659 		    st.c_cc[VERASE] = '\177';	/* ^? */
660 		    st.c_cc[VKILL]  = '\025';	/* ^u */
661 		    st.c_cc[VEOF]   = '\004';	/* ^d */
662 		    tcsetattr(pty_slave_fd, TCSANOW, &st);
663 		}
664 	    }
665 
666 	    switch(pr->pr_Pid = fork())
667 	    {
668 	    case 0:
669 		/* Child process */
670 
671 		child_build_environ ();
672 
673 		if(usepty)
674 		{
675 		    if(setsid() < 0)
676 		    {
677 			perror("child: setsid()");
678 			_exit(255);
679 		    }
680 		    if(pty_slave_fd < 0)
681 		    {
682 			perror("child: open(slave)");
683 			_exit(255);
684 		    }
685 		    close(pr->pr_Stdin);
686 
687 		    dup2(pty_slave_fd, 0);
688 		    dup2(pty_slave_fd, 1);
689 		    dup2(pty_slave_fd, 2);
690 		    if(pty_slave_fd > 2)
691 		    {
692 			close(pty_slave_fd);
693 			pty_slave_fd = -1;
694 		    }
695 		}
696 		else if (PR_CONN_SOCKETPAIR_P(pr))
697 		{
698 		    /* startup for socketpair */
699 		    if(setpgid(0, 0) != 0)
700 		    {
701 			perror("setpgid");
702 			_exit(255);
703 		    }
704 		    close (stdin_fds[0]);
705 		    dup2 (stdin_fds[1], 0);
706 		    dup2 (stdin_fds[1], 1);
707 		    dup2 (stdin_fds[1], 2);
708 		    close (stdin_fds[1]);
709 		}
710 		else
711 		{
712 		    /* startup for pipes */
713 		    if(setpgid(0, 0) != 0)
714 		    {
715 			perror("setpgid");
716 			_exit(255);
717 		    }
718 		    dup2(stdin_fds[0], 0);
719 		    close(stdin_fds[0]);
720 		    if(sync_input == NULL)
721 			close(stdin_fds[1]);
722 
723 		    dup2(stdout_fds[1], 1);
724 		    dup2(stderr_fds[1], 2);
725 		    close(stdout_fds[0]);
726 		    close(stdout_fds[1]);
727 		    close(stderr_fds[0]);
728 		    close(stderr_fds[1]);
729 		}
730 		if(rep_STRINGP(pr->pr_Dir))
731 		{
732 		    if(rep_STRING_LEN(pr->pr_Dir) > 0)
733 			chdir(rep_STR(pr->pr_Dir));
734 		}
735 		signal (SIGPIPE, SIG_DFL);
736 
737 		execvp(argv[0], argv);
738 		int i;
739 		fprintf(stderr, "Can't exec: ");
740 		for(i = 0; ; i++){
741 		  if( argv[i] == NULL){
742 		    break;
743 		  }
744 		  fprintf(stderr, "%s ", argv[i]);
745 		}
746 		fprintf(stderr, "\n");
747 		perror(" ");
748 		_exit(255);
749 
750 	    case -1:
751 		/* Clean up all open files */
752 		if (pty_slave_fd != -1)
753 		    close (pty_slave_fd);
754 		if (PR_CONN_SOCKETPAIR_P(pr))
755 		{
756 		    close (stdin_fds[0]);
757 		    close (stdin_fds[1]);
758 		}
759 		if (sync_input != 0 || !usepty)
760 		{
761 		    /* pipes */
762 		    close(stdout_fds[0]); close(stdout_fds[1]);
763 		    close(stderr_fds[0]); close(stderr_fds[1]);
764 		    close(stdin_fds[0]);
765 		    if (sync_input != 0)
766 			close(stdin_fds[1]);
767 		}
768 		else
769 		    close(pr->pr_Stdin);
770 		pr->pr_Stdin = pr->pr_Stdout = pr->pr_Stderr = 0;
771 		rep_signal_file_error(rep_VAL(&forkstr));
772 		break;
773 
774 	    default:
775 		/* Parent process */
776 
777 		if (pty_slave_fd != -1)
778 		    close (pty_slave_fd);
779 		PR_SET_STATUS(pr, PR_RUNNING);
780 		if (PR_CONN_SOCKETPAIR_P(pr))
781 		{
782 		    close (stdin_fds[1]);
783 		}
784 		else if(!usepty)
785 		{
786 		    close(stdin_fds[0]);
787 		    close(stdout_fds[1]);
788 		    close(stderr_fds[1]);
789 		}
790 		if(sync_input == NULL)
791 		{
792 		    if(pr->pr_Stdin == pr->pr_Stdout)
793 		    {
794 			/* So that pr_Stdout can be made non-blocking
795 			   set up another fd for writing to.  */
796 			if((pr->pr_Stdin = dup(pr->pr_Stdout)) < 0)
797 			{
798 			    /* Maybe this is unwise? */
799 			    perror("dup(pr->pr_Stdout)");
800 			    pr->pr_Stdin = pr->pr_Stdout;
801 			}
802 		    }
803 		    rep_unix_set_fd_cloexec(pr->pr_Stdin);
804 		    rep_unix_set_fd_nonblocking(pr->pr_Stdout);
805 		    rep_register_input_fd(pr->pr_Stdout, read_from_process);
806 		    if(pr->pr_Stderr != pr->pr_Stdout)
807 		    {
808 			rep_unix_set_fd_nonblocking(pr->pr_Stderr);
809 			rep_register_input_fd(pr->pr_Stderr,
810 					      read_from_process);
811 		    }
812 		    process_run_count++;
813 		}
814 		else
815 		{
816 		    /* Run synchronously.  */
817 		    char buf[1025];
818 		    int actual;
819 		    fd_set inputs;
820 		    rep_bool done_out = rep_FALSE, done_err = rep_FALSE;
821 		    rep_bool exited = rep_FALSE;
822 		    int interrupt_count = 0;
823 #ifdef KLUDGE_SYNCHRONOUS_OUTPUT
824 		    int post_exit_count = 0;
825 #endif
826 
827 		    FD_ZERO(&inputs);
828 		    FD_SET(pr->pr_Stdout, &inputs);
829 		    FD_SET(pr->pr_Stderr, &inputs);
830 		    pr->pr_Stdin = 0;
831 		    fcntl(pr->pr_Stdout, F_SETFL, O_NONBLOCK);
832 		    fcntl(pr->pr_Stderr, F_SETFL, O_NONBLOCK);
833 
834 		    while(!(done_out && done_err))
835 		    {
836 			fd_set copy = inputs;
837 			struct timeval timeout;
838 			int number;
839 			timeout.tv_sec = 1;
840 			timeout.tv_usec = 0;
841 
842 			rep_sig_restart(SIGCHLD, rep_FALSE);
843 			number = select(FD_SETSIZE, &copy, NULL,
844 					NULL, &timeout);
845 			rep_sig_restart(SIGCHLD, rep_TRUE);
846 
847 			rep_TEST_INT_SLOW;
848 			if(rep_INTERRUPTP)
849 			{
850 			    int signal;
851 			    /* What to do here? */
852 			    switch(++interrupt_count)
853 			    {
854 			    case 1:
855 				signal = SIGINT;
856 				break;
857 			    case 2:
858 				signal = SIGTERM;
859 				break;
860 			    default:
861 				signal = SIGKILL;
862 			    }
863 			    signal_process(pr, signal, rep_TRUE);
864 			    if(rep_throw_value == rep_int_cell)
865 				rep_throw_value = 0;
866 			}
867 
868 			if(number > 0)
869 			{
870 			    rep_GC_root gc_pr;
871 			    repv vpr = rep_VAL(pr);
872 			    rep_PUSHGC(gc_pr, vpr);
873 			    if(!done_out && FD_ISSET(pr->pr_Stdout, &copy))
874 			    {
875 				actual = read(pr->pr_Stdout, buf, 1024);
876 				if(actual > 0)
877 				{
878 				    buf[actual] = 0;
879 				    if(!rep_NILP(pr->pr_OutputStream))
880 				    {
881 					rep_stream_puts(pr->pr_OutputStream, buf,
882 						    actual, rep_FALSE);
883 				    }
884 				}
885 				else if(actual == 0
886 					|| (errno != EINTR
887 					    && errno != EAGAIN
888 					    && errno != EWOULDBLOCK))
889 				{
890 				    done_out = rep_TRUE;
891 				    FD_CLR(pr->pr_Stdout, &inputs);
892 				}
893 			    }
894 			    if(!done_err && FD_ISSET(pr->pr_Stderr, &copy))
895 			    {
896 				actual = read(pr->pr_Stderr, buf, 1024);
897 				if(actual > 0)
898 				{
899 				    buf[actual] = 0;
900 				    if(!rep_NILP(pr->pr_ErrorStream))
901 				    {
902 					rep_stream_puts(pr->pr_ErrorStream, buf,
903 						    actual, rep_FALSE);
904 				    }
905 				}
906 				else if(actual == 0
907 					|| (errno != EINTR
908 					    && errno != EAGAIN
909 					    && errno != EWOULDBLOCK))
910 				{
911 				    done_err = rep_TRUE;
912 				    FD_CLR(pr->pr_Stderr, &inputs);
913 				}
914 			    }
915 			    rep_POPGC;
916 			}
917 #ifdef KLUDGE_SYNCHRONOUS_OUTPUT
918 			/* This still doesn't work. The best way to
919 			   solve this problem is to move the onus to
920 			   the caller. If a command is called which
921 			   spawns on its streams, they should be
922 			   redirected somewhere safe beforehand. */
923 
924 			/* The next two statements are a bit kludgey.
925 
926 			   Problem: If the child process exits, but has
927 			   spawned an orphan of its own on the same input
928 			   and output streams, the done_out and done_err
929 			   flags won't get set until the _orphan_ quits.
930 
931 			   Solution: Check for process exit here. If it
932 			   has exited, allow a few more timeouts, before
933 			   breaking the loop. */
934 
935 			if(exited && number == 0 && ++post_exit_count > 2)
936 			    break;
937 
938 			if(!exited && got_sigchld
939 			   && waitpid(pr->pr_Pid,
940 				      &pr->pr_ExitStatus,
941 				      WNOHANG) == pr->pr_Pid)
942 			    exited = rep_TRUE;
943 #endif
944 		    }
945 		    if(!exited)
946 			waitpid(pr->pr_Pid, &pr->pr_ExitStatus, 0);
947 
948 		    close(pr->pr_Stdout);
949 		    close(pr->pr_Stderr);
950 		    pr->pr_Stdout = 0;
951 		    pr->pr_Stderr = 0;
952 		    PR_SET_STATUS(pr, PR_DEAD);
953 		    queue_notify(pr);
954 		}
955 		rc = rep_TRUE;
956 		break;
957 	    }
958 	}
959 	else if(rep_throw_value == rep_NULL)
960 	    Fsignal(Qprocess_error, rep_LIST_1(rep_lookup_errno()));
961     }
962     else
963 	Fsignal(Qprocess_error, rep_list_2(rep_VAL(pr), rep_VAL(&already_running)));
964     return(rc);
965 }
966 
967 static void
proc_mark(repv pr)968 proc_mark(repv pr)
969 {
970     rep_MARKVAL(VPROC(pr)->pr_OutputStream);
971     rep_MARKVAL(VPROC(pr)->pr_ErrorStream);
972     rep_MARKVAL(VPROC(pr)->pr_NotifyFun);
973     rep_MARKVAL(VPROC(pr)->pr_Prog);
974     rep_MARKVAL(VPROC(pr)->pr_Args);
975     rep_MARKVAL(VPROC(pr)->pr_Dir);
976     rep_MARKVAL(VPROC(pr)->pr_ConnType);
977 }
978 
979 static void
mark_active_processes(void)980 mark_active_processes(void)
981 {
982     struct Proc *pr = process_chain;
983     while(pr != 0)
984     {
985 	if(PR_ACTIVE_P(pr))
986 	    rep_MARKVAL(rep_VAL(pr));
987 	pr = pr->pr_Next;
988     }
989 }
990 
991 static void
proc_sweep(void)992 proc_sweep(void)
993 {
994     struct Proc *pr;
995 
996     /* First weed out any unused processes from the notify chain...  */
997     pr = notify_chain;
998     notify_chain = NULL;
999     while(pr)
1000     {
1001 	if(rep_GC_CELL_MARKEDP(rep_VAL(pr)))
1002 	{
1003 	    pr->pr_NotifyNext = notify_chain;
1004 	    notify_chain = pr;
1005 	}
1006 	pr = pr->pr_NotifyNext;
1007     }
1008 
1009     /* ...then do the normal sweep stuff.  */
1010     pr = process_chain;
1011     process_chain = NULL;
1012     while(pr)
1013     {
1014 	struct Proc *nxt = pr->pr_Next;
1015 	if(!rep_GC_CELL_MARKEDP(rep_VAL(pr)))
1016 	    kill_process(pr);
1017 	else
1018 	{
1019 	    rep_GC_CLR_CELL(rep_VAL(pr));
1020 	    pr->pr_Next = process_chain;
1021 	    process_chain = pr;
1022 	}
1023 	pr = nxt;
1024     }
1025 }
1026 
1027 static void
proc_prin(repv strm,repv obj)1028 proc_prin(repv strm, repv obj)
1029 {
1030     struct Proc *pr = VPROC(obj);
1031     char buf[40];
1032     rep_stream_puts(strm, "#<process", -1, rep_FALSE);
1033     if(PR_RUNNING_P(pr))
1034     {
1035 	rep_stream_puts(strm, " running: ", -1, rep_FALSE);
1036 	rep_stream_puts(strm, rep_PTR(pr->pr_Prog), -1, rep_TRUE);
1037     }
1038     else if(PR_STOPPED_P(pr))
1039     {
1040 	rep_stream_puts(strm, " stopped: ", -1, rep_FALSE);
1041 	rep_stream_puts(strm, rep_PTR(pr->pr_Prog), -1, rep_TRUE);
1042     }
1043     else
1044     {
1045 	if(pr->pr_ExitStatus != -1)
1046 	{
1047 #ifdef HAVE_SNPRINTF
1048 	    snprintf(buf, sizeof(buf), " exited: 0x%x", pr->pr_ExitStatus);
1049 #else
1050 	    sprintf(buf, " exited: 0x%x", pr->pr_ExitStatus);
1051 #endif
1052 	    rep_stream_puts(strm, buf, -1, rep_FALSE);
1053 	}
1054     }
1055     rep_stream_putc(strm, '>');
1056 }
1057 
1058 static int
proc_putc(repv stream,int c)1059 proc_putc(repv stream, int c)
1060 {
1061     char tmps[2];
1062     tmps[0] = (char)c;
1063     tmps[1] = 0;
1064     return write_to_process(stream, tmps, 1);
1065 }
1066 
1067 static int
proc_puts(repv stream,void * data,int len,rep_bool is_lisp)1068 proc_puts(repv stream, void *data, int len, rep_bool is_lisp)
1069 {
1070     char *buf = is_lisp ? rep_STR(data) : data;
1071     return write_to_process(stream, buf, len);
1072 }
1073 
1074 DEFUN("make-process", Fmake_process, Smake_process, (repv stream, repv fun, repv dir, repv prog, repv args), rep_Subr5) /*
1075 ::doc:rep.io.processes#make-process::
1076 make-process [OUTPUT-STREAM] [FUN] [DIR] [PROGRAM] [ARGS]
1077 
1078 Creates a new process-object, OUTPUT-STREAM is where all output from this
1079 process goes, both stdout and stderr, FUN is a function to call each time
1080 the process running on this object changes state. DIR is the process'
1081 current directory, PROGRAM the filename of the program to run and ARGS a
1082 list of arguments passed to the process.
1083 
1084 Any of the arguments may be unspecified, in which case they can be set
1085 either by the functions provided or by the function called to create the
1086 actual running process.
1087 
1088 If the DIR parameter is nil it will be inherited from the
1089 `default-directory' variable of the current buffer.
1090 ::end:: */
1091 {
1092     repv pr = rep_VAL(rep_ALLOC_CELL(sizeof(struct Proc)));
1093     if(pr != rep_NULL)
1094     {
1095 	rep_GC_root gc_pr;
1096 	rep_data_after_gc += sizeof (struct Proc);
1097 	VPROC(pr)->pr_Car = process_type;
1098 	VPROC(pr)->pr_Next = process_chain;
1099 	process_chain = VPROC(pr);
1100 	VPROC(pr)->pr_NotifyNext = NULL;
1101 	PR_SET_STATUS(VPROC(pr), PR_DEAD);
1102 	VPROC(pr)->pr_Pid = 0;
1103 	VPROC(pr)->pr_Stdin = VPROC(pr)->pr_Stdout = 0;
1104 	VPROC(pr)->pr_ExitStatus = -1;
1105 	VPROC(pr)->pr_OutputStream = stream;
1106 	VPROC(pr)->pr_ErrorStream = stream;
1107 	VPROC(pr)->pr_NotifyFun = fun;
1108 	VPROC(pr)->pr_Prog = prog;
1109 	VPROC(pr)->pr_Args = args;
1110 	VPROC(pr)->pr_ConnType = Qpipe;
1111 	VPROC(pr)->pr_Dir = dir;
1112 
1113 	/* Ensure that pr_Dir refers to an absolute local file */
1114 	rep_PUSHGC(gc_pr, pr);
1115 	dir = Flocal_file_name(rep_STRINGP(dir) ? dir : rep_VAL(&dot));
1116 	rep_POPGC;
1117 	if(dir && rep_STRINGP(dir))
1118 	    VPROC(pr)->pr_Dir = dir;
1119 	else
1120 	    VPROC(pr)->pr_Dir = Qnil;
1121 
1122 	return pr;
1123     }
1124     else
1125 	return rep_mem_error();
1126 }
1127 
1128 DEFUN("close-process", Fclose_process,
1129       Sclose_process, (repv proc), rep_Subr1) /*
1130 ::doc:rep.io.processes#close-process::
1131 close-processes [PROCESS]
1132 
1133 Closes the stdin, stdout, and stderr streams of the asynchronous process-
1134 object PROCESS.
1135 ::end:: */
1136 {
1137     rep_DECLARE1(proc, PROCESSP);
1138     close_proc_files(VPROC(proc));
1139     return(Qnil);
1140 }
1141 
1142 DEFUN("start-process", Fstart_process, Sstart_process, (repv arg_list), rep_SubrN) /*
1143 ::doc:rep.io.processes#start-process::
1144 start-process [PROCESS] [PROGRAM] [ARGS...]
1145 
1146 Starts a process running on process-object PROCESS. The child-process runs
1147 asynchronously with the editor. If PROCESS is unspecified the make-process
1148 function will be called (with zero arguments) to create one.
1149 
1150 PROGRAM is the filename of the binary image, it will be searched for in
1151 all directories listed in the `PATH' environment variable.
1152 ARGS are the arguments to give to the process.
1153 
1154 If any of the optional parameters are unspecified they should have been
1155 set in the PROCESS prior to calling this function.
1156 ::end:: */
1157 {
1158     struct Proc *pr = NULL;
1159     repv res = Qnil;
1160     if(rep_CONSP(arg_list))
1161     {
1162 	if(PROCESSP(rep_CAR(arg_list)))
1163 	    pr = VPROC(rep_CAR(arg_list));
1164 	arg_list = rep_CDR(arg_list);
1165     }
1166     if(pr == NULL)
1167     {
1168 	pr = VPROC(Fmake_process(Qnil, Qnil, Qnil,
1169 				    Qnil, Qnil));
1170 	if(pr == NULL)
1171 	    return rep_NULL;
1172     }
1173     if(rep_CONSP(arg_list))
1174     {
1175 	if(rep_STRINGP(rep_CAR(arg_list)))
1176 	    pr->pr_Prog = rep_CAR(arg_list);
1177 	arg_list = rep_CDR(arg_list);
1178 	if(rep_CONSP(arg_list))
1179 	    pr->pr_Args = arg_list;
1180     }
1181     if(!rep_STRINGP(pr->pr_Prog))
1182     {
1183 	res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&no_prog), rep_VAL(pr)));
1184     }
1185     else
1186     {
1187 	int numargs = rep_list_length(pr->pr_Args) + 1;
1188 	char **argv = rep_alloc(sizeof(char *) * (numargs + 1));
1189 	if(argv)
1190 	{
1191 	    int i;
1192 	    arg_list = pr->pr_Args;
1193 	    argv[0] = rep_STR(pr->pr_Prog);
1194 	    for(i = 1; i < numargs; i++)
1195 	    {
1196 		if(rep_STRINGP(rep_CAR(arg_list)))
1197 		    argv[i] = rep_STR(rep_CAR(arg_list));
1198 		else
1199 		    argv[i] = "";
1200 		arg_list = rep_CDR(arg_list);
1201 	    }
1202 	    argv[i] = NULL;
1203 	    if(run_process(pr, argv, NULL))
1204 		res = rep_VAL(pr);
1205 	    else
1206 	    {
1207 		res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&cant_start),
1208 							   rep_VAL(pr)));
1209 	    }
1210 	    rep_free(argv);
1211 	}
1212     }
1213     return(res);
1214 }
1215 
1216 DEFUN("call-process", Fcall_process, Scall_process, (repv arg_list), rep_SubrN) /*
1217 ::doc:rep.io.processes#call-process::
1218 call-process [PROCESS] [IN-FILE] [PROGRAM] [ARGS...]
1219 
1220 Starts a process running on process-object PROCESS. Waits for the child to
1221 exit, then returns the exit-value of the child. If PROCESS is unspecified
1222 the make-process function will be called (with zero arguments) to create one.
1223 
1224 IN-FILE is the name of the file to connect to the process' standard input,
1225 if this is not defined `/dev/null' is used.
1226 PROGRAM is the filename of the binary image, it will be searched for in
1227 all directories listed in the `PATH' environment variable.
1228 ARGS are the arguments to give to the process.
1229 
1230 If any of the optional parameters are unspecified they should have been
1231 set in the PROCESS prior to calling this function.
1232 ::end:: */
1233 {
1234     struct Proc *pr = NULL;
1235     repv res = Qnil, infile = rep_VAL(&dev_null);
1236     if(rep_CONSP(arg_list))
1237     {
1238 	if(PROCESSP(rep_CAR(arg_list)))
1239 	    pr = VPROC(rep_CAR(arg_list));
1240 	arg_list = rep_CDR(arg_list);
1241     }
1242     if(pr == NULL)
1243     {
1244 	pr = VPROC(Fmake_process(Qnil, Qnil, Qnil,
1245 				    Qnil, Qnil));
1246 	if(pr == NULL)
1247 	    return rep_NULL;
1248     }
1249     if(rep_CONSP(arg_list))
1250     {
1251 	if(rep_STRINGP(rep_CAR(arg_list)))
1252 	    infile = rep_CAR(arg_list);
1253 	arg_list = rep_CDR(arg_list);
1254 	if(rep_CONSP(arg_list))
1255 	{
1256 	    if(rep_STRINGP(rep_CAR(arg_list)))
1257 		pr->pr_Prog = rep_CAR(arg_list);
1258 	    arg_list = rep_CDR(arg_list);
1259 	    if(rep_CONSP(arg_list))
1260 		pr->pr_Args = arg_list;
1261 	}
1262     }
1263     if(infile != rep_VAL(&dev_null))
1264     {
1265 	/* Ensure that INFILE is a real name in the local file
1266 	   system, and that the file actually exists. */
1267 	rep_GC_root gc_arg_list, gc_pr, gc_infile;
1268 	repv _pr = rep_VAL(pr);
1269 	rep_PUSHGC(gc_arg_list, arg_list);
1270 	rep_PUSHGC(gc_pr, _pr);
1271 	rep_PUSHGC(gc_infile, infile);
1272 	infile = Flocal_file_name(infile);
1273 	if(infile && rep_STRINGP(infile))
1274 	{
1275 	    if(rep_NILP(rep_file_exists_p(infile)))
1276 		res = rep_signal_file_error(infile);
1277 	}
1278 	else
1279 	    res = Fsignal(Qprocess_error,
1280 			     rep_LIST_2(rep_VAL(&not_local), rep_VAL(pr)));
1281 	rep_POPGC; rep_POPGC; rep_POPGC;
1282     }
1283     if(rep_NILP(res) && !rep_STRINGP(pr->pr_Prog))
1284 	res = Fsignal(Qprocess_error, rep_LIST_2(rep_VAL(&no_prog), rep_VAL(pr)));
1285     if(rep_NILP(res))
1286     {
1287 	int numargs = rep_list_length(pr->pr_Args) + 1;
1288 	char **argv = rep_alloc(sizeof(char *) * (numargs + 1));
1289 	if(argv)
1290 	{
1291 	    int i;
1292 	    arg_list = pr->pr_Args;
1293 	    argv[0] = rep_STR(pr->pr_Prog);
1294 	    for(i = 1; i < numargs; i++)
1295 	    {
1296 		if(rep_STRINGP(rep_CAR(arg_list)))
1297 		    argv[i] = rep_STR(rep_CAR(arg_list));
1298 		else
1299 		    argv[i] = "";
1300 		arg_list = rep_CDR(arg_list);
1301 	    }
1302 	    argv[i] = NULL;
1303 	    if(run_process(pr, argv, rep_STR(infile)))
1304 		res = rep_MAKE_INT(pr->pr_ExitStatus);
1305 	    else
1306 	    {
1307 		res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&cant_start),
1308 							   rep_VAL(pr)));
1309 	    }
1310 	    rep_free(argv);
1311 	}
1312     }
1313     return(res);
1314 }
1315 
1316 /* If PROC is running asynchronously then send signal number SIGNAL
1317    to it. If SIGNAL-GROUP is non-nil send the signal to all processes
1318    in the process group of PROC. Returns t if successful. */
1319 static repv
do_signal_command(repv proc,int signal,repv signal_group)1320 do_signal_command(repv proc, int signal, repv signal_group)
1321 {
1322     repv res = Qnil;
1323     rep_DECLARE1(proc, PROCESSP);
1324     if(PR_ACTIVE_P(VPROC(proc)))
1325     {
1326 	if(signal_process(VPROC(proc), signal, !rep_NILP(signal_group)))
1327 	    res = Qt;
1328     }
1329     else
1330     {
1331 	res = Fsignal(Qprocess_error, rep_list_2(proc, rep_VAL(&not_running)));
1332     }
1333     return res;
1334 }
1335 
1336 DEFUN("interrupt-process", Finterrupt_process, Sinterrupt_process, (repv proc, repv grp), rep_Subr2) /*
1337 ::doc:rep.io.processes#interrupt-process::
1338 interrupt-process PROCESS [SIGNAL-GROUP]
1339 
1340 Interrupt the asynchronous process PROCESS. If SIGNAL-GROUP is t, interrupt
1341 all child processes of PROCESS (it's process group).
1342 ::end:: */
1343 {
1344     return do_signal_command(proc, SIGINT, grp);
1345 }
1346 
1347 DEFUN("kill-process", Fkill_process, Skill_process, (repv proc, repv grp), rep_Subr2) /*
1348 ::doc:rep.io.processes#kill-process::
1349 kill-process PROCESS [SIGNAL-GROUP]
1350 
1351 Kill the asynchronous process PROCESS. If SIGNAL-GROUP is t, kill all
1352 child processes of PROCESS (it's process group).
1353 ::end:: */
1354 {
1355     return do_signal_command(proc, SIGKILL, grp);
1356 }
1357 
1358 DEFUN("stop-process", Fstop_process, Sstop_process, (repv proc, repv grp), rep_Subr2) /*
1359 ::doc:rep.io.processes#stop-process::
1360 stop-process PROCESS [SIGNAL-GROUP]
1361 
1362 Suspends execution of PROCESS, see `continue-process'. If SIGNAL-GROUP is
1363 non-nil also suspends the processes in the process group of PROCESS.
1364 ::end:: */
1365 {
1366     return do_signal_command(proc, SIGSTOP, grp);
1367 }
1368 
1369 DEFUN("continue-process", Fcontinue_process, Scontinue_process, (repv proc, repv grp), rep_Subr2) /*
1370 ::doc:rep.io.processes#continue-process::
1371 continue-process PROCESS [SIGNAL-GROUP]
1372 
1373 Restarts PROCESS after it has been stopped (via `stop-process'). If
1374 SIGNAL-GROUP is non-nil also continues the processes in the process group of
1375 PROCESS.
1376 ::end:: */
1377 {
1378     repv res = Qt;
1379     rep_DECLARE1(proc, PROCESSP);
1380     if(PR_STOPPED_P(VPROC(proc)))
1381     {
1382 	if(signal_process(VPROC(proc), SIGCONT, !rep_NILP(grp)))
1383 	{
1384 	    PR_SET_STATUS(VPROC(proc), PR_RUNNING);
1385 	    res = Qt;
1386 	    queue_notify(VPROC(proc));
1387 	}
1388     }
1389     else
1390     {
1391 	res = Fsignal(Qprocess_error, rep_list_2(proc, rep_VAL(&not_stopped)));
1392     }
1393     return(res);
1394 }
1395 
1396 DEFUN("signal-process", Fsignal_process, Ssignal_process,
1397       (repv proc, repv sig, repv grp), rep_Subr3) /*
1398 ::doc:rep.io.processes#signal_process::
1399 signal-process PROCESS SIGNAL [SIGNAL-GROUP]
1400 
1401 Sends the signal SIGNAL to the process PROCESS. If SIGNAL-GROUP is
1402 non-nil also continues the processes in the process group of PROCESS.
1403 
1404 PROCESS may be either a Lisp process object, or an integer giving the
1405 process-id of a process (not necessarily started by rep).
1406 
1407 SIGNAL may either be a numeric signal, or a symbol naming a signal, i.e.
1408 the symbol `INT' for the UNIX SIGINT signal.
1409 ::end:: */
1410 {
1411     static const struct {
1412 	const char *name;
1413 	int sig;
1414     } signals[] = {
1415 #ifdef SIGFPE
1416 	{ "FPE", SIGFPE },
1417 #endif
1418 #ifdef SIGILL
1419 	{ "ILL", SIGILL },
1420 #endif
1421 #ifdef SIGSEGV
1422 	{ "SEGV", SIGSEGV },
1423 #endif
1424 #ifdef SIGBUS
1425 	{ "BUS", SIGBUS },
1426 #endif
1427 #ifdef SIGABRT
1428  	{ "ABRT", SIGABRT },
1429 #endif
1430 #ifdef SIGIOT
1431 	{ "IOT", SIGIOT },
1432 #endif
1433 #ifdef SIGTRAP
1434 	{ "TRAP", SIGTRAP },
1435 #endif
1436 #ifdef SIGEMT
1437 	{ "EMT", SIGEMT },
1438 #endif
1439 #ifdef SIGSYS
1440 	{ "SYS", SIGSYS },
1441 #endif
1442 #ifdef SIGTERM
1443 	{ "TERM", SIGTERM },
1444 #endif
1445 #ifdef SIGINT
1446 	{ "INT", SIGINT },
1447 #endif
1448 #ifdef SIGQUIT
1449 	{ "QUIT", SIGQUIT },
1450 #endif
1451 #ifdef SIGKILL
1452 	{ "KILL", SIGKILL },
1453 #endif
1454 #ifdef SIGHUP
1455 	{ "HUP", SIGHUP },
1456 #endif
1457 #ifdef SIGALRM
1458 	{ "ALRM", SIGALRM },
1459 #endif
1460 #ifdef SIGVTALRM
1461 	{ "VTALRM", SIGVTALRM },
1462 #endif
1463 #ifdef SIGPROF
1464 	{ "PROF", SIGPROF },
1465 #endif
1466 #ifdef SIGIO
1467 	{ "IO", SIGIO },
1468 #endif
1469 #ifdef SIGURG
1470 	{ "URG", SIGURG },
1471 #endif
1472 #ifdef SIGPOLL
1473 	{ "POLL", SIGPOLL },
1474 #endif
1475 #ifdef SIGCHLD
1476 	{ "CHLD", SIGCHLD }, { "CLD", SIGCHLD },
1477 #endif
1478 #ifdef SIGCONT
1479 	{ "CONT", SIGCONT },
1480 #endif
1481 #ifdef SIGSTOP
1482 	{ "STOP", SIGSTOP },
1483 #endif
1484 #ifdef SIGTSTP
1485 	{ "TSTP", SIGTSTP },
1486 #endif
1487 #ifdef SIGTTIN
1488 	{ "TTIN", SIGTTIN },
1489 #endif
1490 #ifdef SIGTTOU
1491 	{ "TTOU", SIGTTOU },
1492 #endif
1493 #ifdef SIGPIPE
1494 	{ "PIPE", SIGPIPE },
1495 #endif
1496 #ifdef SIGLOST
1497 	{ "LOST", SIGLOST },
1498 #endif
1499 #ifdef SIGXCPU
1500 	{ "XCPU", SIGXCPU },
1501 #endif
1502 #ifdef SIGXFSZ
1503 	{ "XFSZ", SIGXFSZ },
1504 #endif
1505 #ifdef SIGUSR1
1506 	{ "USR1", SIGUSR1 },
1507 #endif
1508 #ifdef SIGUSR2
1509 	{ "USR2", SIGUSR2 },
1510 #endif
1511 #ifdef SIGWINCH
1512 	{ "WINCH", SIGWINCH },
1513 #endif
1514 #ifdef SIGINFO
1515 	{ "INFO", SIGINFO },
1516 #endif
1517 	{ 0 }
1518     };
1519 
1520     int signal = -1;
1521 
1522     rep_DECLARE(1, proc, PROCESSP(proc) || rep_INTP(proc));
1523     rep_DECLARE(2, sig, rep_INTP(sig) || rep_SYMBOLP(sig));
1524 
1525     if (rep_INTP(sig))
1526 	signal = rep_INT(sig);
1527     else
1528     {
1529 	char *s = rep_STR(rep_SYM(sig)->name);
1530 	int i;
1531 	for (i = 0; signals[i].name != 0; i++)
1532 	{
1533 	    if (strcmp (s, signals[i].name) == 0)
1534 	    {
1535 		signal = signals[i].sig;
1536 		break;
1537 	    }
1538 	}
1539 	if (signal == -1)
1540 	    return Fsignal (Qerror, rep_list_2 (rep_VAL(&nosig), sig));
1541     }
1542 
1543     if (rep_INTP(proc) && rep_INT(proc) > 0)
1544     {
1545 	struct Proc *pr = process_chain;
1546 	while (pr != 0 && pr->pr_Pid != rep_INT(proc))
1547 	    pr = pr->pr_Next;
1548 	if (pr != 0)
1549 	    proc = rep_VAL(pr);
1550     }
1551 
1552     if (PROCESSP(proc))
1553 	return do_signal_command (proc, signal, grp);
1554     else
1555     {
1556 	int r;
1557 	if (grp != Qnil)
1558 	    r = kill (- rep_INT(proc), signal);
1559 	else
1560 	    r = kill (rep_INT(proc), signal);
1561 	return (r == 0) ? Qt : Qnil;
1562     }
1563 }
1564 
1565 DEFUN("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, (repv proc), rep_Subr1) /*
1566 ::doc:rep.io.processes#process-exit-status::
1567 process-exit-status PROCESS
1568 
1569 Returns the unprocessed exit-status of the last process to be run on the
1570 process-object PROCESS. If PROCESS is currently running, return nil.
1571 ::end:: */
1572 {
1573     repv res = Qnil;
1574     rep_DECLARE1(proc, PROCESSP);
1575     if(PR_DEAD_P(VPROC(proc)))
1576     {
1577 	if(VPROC(proc)->pr_ExitStatus != -1)
1578 	    res = rep_MAKE_INT(VPROC(proc)->pr_ExitStatus);
1579     }
1580     return(res);
1581 }
1582 
1583 DEFUN("process-exit-value", Fprocess_exit_value, Sprocess_exit_value, (repv proc), rep_Subr1) /*
1584 ::doc:rep.io.processes#process-exit-value::
1585 process-exit-value PROCESS
1586 
1587 Returns the return-value of the last process to be run on PROCESS, or nil if:
1588   a) no process has run on PROCESS
1589   b) PROCESS is still running
1590   c) PROCESS exited abnormally
1591 ::end:: */
1592 {
1593     repv res = Qnil;
1594     rep_DECLARE1(proc, PROCESSP);
1595     if((PR_DEAD_P(VPROC(proc)))
1596        && (VPROC(proc)->pr_ExitStatus != -1))
1597 	res = rep_MAKE_INT(WEXITSTATUS(VPROC(proc)->pr_ExitStatus));
1598     return(res);
1599 }
1600 
1601 DEFUN("process-id", Fprocess_id, Sprocess_id, (repv proc), rep_Subr1) /*
1602 ::doc:rep.io.processes#process-id::
1603 process-id [PROCESS]
1604 
1605 If PROCESS is running or stopped, return the process-identifier associated
1606 with it (ie, its pid).
1607 
1608 If PROCESS is nil, return the process id of the Lisp interpreter.
1609 ::end:: */
1610 {
1611     if (proc == Qnil)
1612 	return rep_MAKE_INT(getpid ());
1613     else
1614     {
1615 	repv res = Qnil;
1616 	rep_DECLARE1(proc, PROCESSP);
1617 	if(PR_ACTIVE_P(VPROC(proc)))
1618 	    res = rep_MAKE_INT(VPROC(proc)->pr_Pid);
1619 	return(res);
1620     }
1621 }
1622 
1623 DEFUN("process-running-p", Fprocess_running_p, Sprocess_running_p, (repv proc), rep_Subr1) /*
1624 ::doc:rep.io.processes#process-running-p::
1625 process-running-p PROCESS
1626 
1627 Return t if PROCESS is running.
1628 ::end:: */
1629 {
1630     repv res;
1631     rep_DECLARE1(proc, PROCESSP);
1632     if(PR_RUNNING_P(VPROC(proc)))
1633 	res = Qt;
1634     else
1635 	res = Qnil;
1636     return(res);
1637 }
1638 
1639 DEFUN("process-stopped-p", Fprocess_stopped_p, Sprocess_stopped_p, (repv proc), rep_Subr1) /*
1640 ::doc:rep.io.processes#process-stopped-p::
1641 process-stopped-p PROCESS
1642 
1643 Return t if PROCESS has been stopped.
1644 ::end:: */
1645 {
1646     repv res;
1647     rep_DECLARE1(proc, PROCESSP);
1648     if(PR_STOPPED_P(VPROC(proc)))
1649 	res = Qt;
1650     else
1651 	res = Qnil;
1652     return(res);
1653 }
1654 
1655 DEFUN("process-in-use-p", Fprocess_in_use_p, Sprocess_in_use_p, (repv proc), rep_Subr1) /*
1656 ::doc:rep.io.processes#process-in-use-p::
1657 process-in-use-p PROCESS
1658 
1659 Similar to `process-running-p' except that this returns t even when the
1660 process has stopped.
1661 ::end:: */
1662 {
1663     repv res;
1664     rep_DECLARE1(proc, PROCESSP);
1665     if(PR_ACTIVE_P(VPROC(proc)))
1666 	res = Qt;
1667     else
1668 	res = Qnil;
1669     return(res);
1670 }
1671 
1672 DEFUN("processp", Fprocessp, Sprocessp, (repv arg), rep_Subr1) /*
1673 ::doc:rep.io.processes#process-p::
1674 processp ARG
1675 
1676 Return t is ARG is a process-object.
1677 ::end:: */
1678 {
1679     if(PROCESSP(arg))
1680 	return(Qt);
1681     return(Qnil);
1682 }
1683 
1684 DEFUN("process-prog", Fprocess_prog, Sprocess_prog, (repv proc), rep_Subr1) /*
1685 ::doc:rep.io.processes#process-prog::
1686 process-prog PROCESS
1687 
1688 Return the name of the program in PROCESS.
1689 ::end:: */
1690 {
1691     repv res;
1692     rep_DECLARE1(proc, PROCESSP);
1693     res = VPROC(proc)->pr_Prog;
1694     return(res);
1695 }
1696 
1697 DEFUN("set-process-prog", Fset_process_prog, Sset_process_prog, (repv proc, repv prog), rep_Subr2) /*
1698 ::doc:rep.io.processes#set-process-prog::
1699 set-process-prog PROCESS PROGRAM
1700 
1701 Sets the name of the program to run on PROCESS to FILE.
1702 ::end:: */
1703 {
1704     rep_DECLARE1(proc, PROCESSP);
1705     rep_DECLARE2(prog, rep_STRINGP);
1706     VPROC(proc)->pr_Prog = prog;
1707     return(prog);
1708 }
1709 
1710 DEFUN("process-args", Fprocess_args, Sprocess_args, (repv proc), rep_Subr1) /*
1711 ::doc:rep.io.processes#process-args::
1712 process-args PROCESS
1713 
1714 Return the list of arguments to PROCESS.
1715 ::end:: */
1716 {
1717     repv res;
1718     rep_DECLARE1(proc, PROCESSP);
1719     res = VPROC(proc)->pr_Args;
1720     return(res);
1721 }
1722 
1723 DEFUN("set-process-args", Fset_process_args, Sset_process_args, (repv proc, repv args), rep_Subr2) /*
1724 ::doc:rep.io.processes#set-process-args::
1725 set-process-args PROCESS ARG-LIST
1726 
1727 Set the arguments to PROCESS.
1728 ::end:: */
1729 {
1730     rep_DECLARE1(proc, PROCESSP);
1731     if(!rep_NILP(args) && !rep_CONSP(args))
1732 	return(rep_signal_arg_error(args, 2));
1733     VPROC(proc)->pr_Args = args;
1734     return(args);
1735 }
1736 
1737 DEFUN("process-output-stream", Fprocess_output_stream, Sprocess_output_stream, (repv proc), rep_Subr1) /*
1738 ::doc:rep.io.processes#process-output-stream::
1739 process-output-stream PROCESS
1740 
1741 Return the stream to which all output from PROCESS is sent.
1742 ::end:: */
1743 {
1744     repv res;
1745     rep_DECLARE1(proc, PROCESSP);
1746     res = VPROC(proc)->pr_OutputStream;
1747     return(res);
1748 }
1749 
1750 DEFUN("set-process-output-stream", Fset_process_output_stream, Sset_process_output_stream, (repv proc, repv stream), rep_Subr2) /*
1751 ::doc:rep.io.processes#set-process-output-stream::
1752 set-process-output-stream PROCESS STREAM
1753 
1754 Set the output-stream of PROCESS to STREAM. nil means discard all output.
1755 ::end:: */
1756 {
1757     rep_DECLARE1(proc, PROCESSP);
1758     VPROC(proc)->pr_OutputStream = stream;
1759     return(stream);
1760 }
1761 
1762 DEFUN("process-error-stream", Fprocess_error_stream, Sprocess_error_stream, (repv proc), rep_Subr1) /*
1763 ::doc:rep.io.processes#process-error-stream::
1764 process-error-stream PROCESS
1765 
1766 Return the stream to which all standard-error output from PROCESS is sent.
1767 ::end:: */
1768 {
1769     repv res;
1770     rep_DECLARE1(proc, PROCESSP);
1771     res = VPROC(proc)->pr_ErrorStream;
1772     return(res);
1773 }
1774 
1775 DEFUN("set-process-error-stream", Fset_process_error_stream, Sset_process_error_stream, (repv proc, repv stream), rep_Subr2) /*
1776 ::doc:rep.io.processes#set-process-error-stream::
1777 set-process-error-stream PROCESS STREAM
1778 
1779 Set the error-stream of PROCESS to STREAM. nil means discard all output.
1780 
1781 Note that this currently only works correctly with pipe connections.
1782 ::end:: */
1783 {
1784     rep_DECLARE1(proc, PROCESSP);
1785     VPROC(proc)->pr_ErrorStream = stream;
1786     return(stream);
1787 }
1788 
1789 DEFUN("process-function", Fprocess_function, Sprocess_function, (repv proc), rep_Subr1) /*
1790 ::doc:rep.io.processes#process-function::
1791 process-function PROCESS
1792 
1793 Return the function which is called when PROCESS changes state (i.e. it
1794 exits or is stopped).
1795 ::end:: */
1796 {
1797     repv res;
1798     rep_DECLARE1(proc, PROCESSP);
1799     res = VPROC(proc)->pr_NotifyFun;
1800     return(res);
1801 }
1802 
1803 DEFUN("set-process-function", Fset_process_function, Sset_process_function, (repv proc, repv fn), rep_Subr2) /*
1804 ::doc:rep.io.processes#set-process-function::
1805 set-process-function PROCESS FUNCTION
1806 
1807 Set the function which is called when PROCESS changes state to FUNCTION.
1808 ::end:: */
1809 {
1810     rep_DECLARE1(proc, PROCESSP);
1811     VPROC(proc)->pr_NotifyFun = fn;
1812     return(fn);
1813 }
1814 
1815 DEFUN("process-dir", Fprocess_dir, Sprocess_dir, (repv proc), rep_Subr1) /*
1816 ::doc:rep.io.processes#process-dir::
1817 process-dir PROCESS
1818 
1819 Return the name of the directory which becomes the working directory of
1820 PROCESS when it is started.
1821 ::end:: */
1822 {
1823     repv res;
1824     rep_DECLARE1(proc, PROCESSP);
1825     res = VPROC(proc)->pr_Dir;
1826     return(res);
1827 }
1828 
1829 DEFUN("set-process-dir", Fset_process_dir, Sset_process_dir, (repv proc, repv dir), rep_Subr2) /*
1830 ::doc:rep.io.processes#set-process-dir::
1831 set-process-dir PROCESS DIR
1832 
1833 Set the directory of PROCESS to DIR.
1834 ::end:: */
1835 {
1836     rep_GC_root gc_proc;
1837     rep_DECLARE1(proc, PROCESSP);
1838     rep_DECLARE2(dir, rep_STRINGP);
1839 
1840     /* Ensure that pr_Dir refers to an absolute local file */
1841     rep_PUSHGC(gc_proc, proc);
1842     dir = Flocal_file_name(rep_STRINGP(dir) ? dir : rep_VAL(&dot));
1843     rep_POPGC;
1844     if(dir && rep_STRINGP(dir))
1845 	VPROC(proc)->pr_Dir = dir;
1846     else
1847 	VPROC(proc)->pr_Dir = Qnil;
1848 
1849     return VPROC(proc)->pr_Dir;;
1850 }
1851 
1852 DEFUN("process-connection-type", Fprocess_connection_type, Sprocess_connection_type, (repv proc), rep_Subr1) /*
1853 ::doc:rep.io.processes#process-connection-type::
1854 process-connection-type PROCESS
1855 
1856 Returns a symbol defining the type of stream (i.e. pipe, pty, or
1857 socketpair) used to connect PROCESS with its physical process.
1858 ::end:: */
1859 {
1860     repv res;
1861     rep_DECLARE1(proc, PROCESSP);
1862     res = VPROC(proc)->pr_ConnType;
1863     return(res);
1864 }
1865 
1866 DEFUN("set-process-connection-type", Fset_process_connection_type, Sset_process_connection_type, (repv proc, repv type), rep_Subr2) /*
1867 ::doc:rep.io.processes#set-process-connection-type::
1868 set-process-connection-type PROCESS TYPE
1869 
1870 Define how PROCESS communicates with it's child process, TYPE may be
1871 one of the following symbols:
1872 
1873   pty		Use a pty
1874   pipe		Three pipes are used
1875   socketpair	Use a socketpair
1876 
1877 This function can only be used when PROCESS is not in use.
1878 
1879 Note that only the `pipe' connection type allows process output and
1880 process error output to be differentiated.
1881 ::end:: */
1882 {
1883     rep_DECLARE1(proc, PROCESSP);
1884     if(PR_ACTIVE_P(VPROC(proc)))
1885 	type = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&in_use), proc));
1886     else
1887 	VPROC(proc)->pr_ConnType = type;
1888     return(type);
1889 }
1890 
1891 DEFUN("active-processes", Factive_processes, Sactive_processes, (void),
1892       rep_Subr0) /*
1893 ::doc:rep.io.processes#active-processes::
1894 active-processes
1895 
1896 Return a list containing all active process objects.
1897 ::end:: */
1898 {
1899     repv head = Qnil;
1900     repv *ptr = &head;
1901     struct Proc *p = process_chain;
1902     while(p != 0)
1903     {
1904 	if(PR_ACTIVE_P(p))
1905 	{
1906 	    *ptr = Fcons(rep_VAL(p), Qnil);
1907 	    ptr = &(rep_CDR(*ptr));
1908 	}
1909 	p = p->pr_Next;
1910     }
1911     return head;
1912 }
1913 
1914 #define MAX_HANDLERS 16
1915 static void (*input_handlers[MAX_HANDLERS])(int);
1916 static int n_input_handlers = 0;
1917 
1918 void
rep_register_process_input_handler(void (* handler)(int))1919 rep_register_process_input_handler (void (*handler)(int))
1920 {
1921     assert (n_input_handlers < MAX_HANDLERS);
1922     input_handlers[n_input_handlers++] = handler;
1923 }
1924 
1925 DEFUN("accept-process-output", Faccept_process_output,
1926       Saccept_process_output, (repv secs, repv msecs), rep_Subr2) /*
1927 ::doc:rep.io.processes#accept-process-output::
1928 accept-process-output [SECONDS] [MILLISECONDS]
1929 
1930 Wait SECONDS plus MILLISECONDS for output from any asynchronous subprocesses.
1931 If any arrives, process it, then return nil. Otherwise return t.
1932 
1933 Note that output includes notification of process termination.
1934 ::end:: */
1935 {
1936     repv result = Qt;
1937     rep_DECLARE2_OPT(secs, rep_NUMERICP);
1938     rep_DECLARE3_OPT(msecs, rep_NUMERICP);
1939     /* Only wait for output if nothing already waiting. */
1940     if(!got_sigchld && !notify_chain)
1941     {
1942 	result = (rep_accept_input_for_callbacks
1943 		  ((rep_get_long_int (secs) * 1000)
1944 		   + (rep_get_long_int (msecs)),
1945 		   n_input_handlers, input_handlers));
1946     }
1947     if(got_sigchld || notify_chain)
1948     {
1949 	result = Qnil;
1950 	rep_proc_periodically();
1951     }
1952     return result;
1953 }
1954 
1955 DEFUN("accept-process-output-1", Faccept_process_output_1,
1956       Saccept_process_output_1,
1957       (repv process, repv secs, repv msecs), rep_Subr3) /*
1958 ::doc:rep.io.processes#accept-process-output-1::
1959 accept-process-output-1 PROCESS [SECONDS] [MILLISECONDS]
1960 
1961 Wait SECONDS plus MILLISECONDS for output from the asynchronous
1962 subprocess PROCESS. If any arrives, process it, then return nil.
1963 Otherwise return t.
1964 
1965 Note that output includes notification of process termination.
1966 ::end:: */
1967 {
1968     repv result = Qt;
1969     rep_DECLARE1 (process, PROCESSP);
1970     rep_DECLARE2_OPT(secs, rep_NUMERICP);
1971     rep_DECLARE3_OPT(msecs, rep_NUMERICP);
1972 
1973     /* Only wait for output if nothing already waiting. */
1974     if (got_sigchld)
1975 	check_for_zombies ();
1976 
1977     if (!notify_queued_p (VPROC (process)))
1978     {
1979 	int fds[2];
1980 	fds[0] = VPROC (process)->pr_Stdout;
1981 	fds[1] = VPROC (process)->pr_Stderr;
1982 	result = (rep_accept_input_for_fds
1983 		  ((rep_get_long_int (secs) * 1000)
1984 		   + rep_get_long_int (msecs), 2, fds));
1985     }
1986 
1987     if (got_sigchld)
1988 	check_for_zombies ();
1989 
1990     if (notify_queued_p (VPROC (process)))
1991     {
1992 	notify_1 (VPROC (process));
1993 	result = Qt;
1994     }
1995 
1996     return result;
1997 }
1998 
1999 /* Don't use libc system (), since it blocks signals. */
2000 repv
rep_system(char * command)2001 rep_system (char *command)
2002 {
2003     int pid, status;
2004     int interrupt_count = 0;
2005 
2006     pid = fork ();
2007     switch (pid)
2008     {
2009 	char *argv[4];
2010 	repv ret;
2011 	DEFSTRING (cant_fork, "can't fork ()");
2012 
2013     case -1:
2014 	return Fsignal (Qerror, Fcons (rep_VAL (&cant_fork), Qnil));
2015 
2016     case 0:
2017 	child_build_environ ();
2018 	argv[0] = "sh";
2019 	argv[1] = "-c";
2020 	argv[2] = command;
2021 	argv[3] = 0;
2022 	signal (SIGPIPE, SIG_DFL);
2023 	execve ("/bin/sh", argv, environ);
2024 	perror ("can't exec /bin/sh");
2025 	_exit (255);
2026 
2027     default:
2028 	ret = Qnil;
2029 	rep_sig_restart (SIGCHLD, rep_FALSE);
2030 	while (1)
2031 	{
2032 	    struct timeval timeout;
2033 	    int x;
2034 
2035 	    rep_TEST_INT_SLOW;
2036 	    if (rep_INTERRUPTP)
2037 	    {
2038 		static int signals[] = { SIGINT, SIGTERM, SIGQUIT };
2039 		if (interrupt_count < 3)
2040 		    interrupt_count++;
2041 		kill (pid, signals[interrupt_count - 1]);
2042 		if (rep_throw_value == rep_int_cell)
2043 		    rep_throw_value = rep_NULL;
2044 	    }
2045 
2046 	    x = waitpid (pid, &status, WNOHANG);
2047 	    if (x == -1)
2048 	    {
2049 		if (errno != EINTR && errno != EAGAIN)
2050 		{
2051 		    DEFSTRING (cant_waitpid, "can't waitpid ()");
2052 		    ret = Fsignal (Qerror,
2053 				   Fcons (rep_VAL (&cant_waitpid), Qnil));
2054 		    break;
2055 		}
2056 	    }
2057 	    else if (x == pid)
2058 	    {
2059 		ret = rep_MAKE_INT (status);
2060 		break;
2061 	    }
2062 
2063 	    timeout.tv_sec = 1;
2064 	    timeout.tv_usec = 0;
2065 	    select (FD_SETSIZE, NULL, NULL, NULL, &timeout);
2066 	}
2067 	rep_sig_restart (SIGCHLD, rep_TRUE);
2068 	return ret;
2069     }
2070 }
2071 
2072 void
rep_proc_init(void)2073 rep_proc_init(void)
2074 {
2075     repv tem;
2076 
2077     /* Setup SIGCHLD stuff.  */
2078     sigemptyset(&chld_sigset);
2079     sigaddset(&chld_sigset, SIGCHLD);
2080     chld_sigact.sa_handler = sigchld_handler;
2081     chld_sigact.sa_mask = chld_sigset;
2082 #ifdef SA_RESTART
2083     chld_sigact.sa_flags = SA_RESTART;
2084 #else
2085     chld_sigact.sa_flags = 0;
2086 #endif
2087     sigaction(SIGCHLD, &chld_sigact, NULL);
2088 
2089     /* Is this necessary?? Better safe than core-dumped ;-)  */
2090     signal(SIGPIPE, SIG_IGN);
2091 
2092     rep_INTERN(pipe);
2093     rep_INTERN(pty);
2094     rep_INTERN(socketpair);
2095 
2096     tem = rep_push_structure ("rep.io.processes");
2097     rep_ADD_SUBR(Sclose_process);
2098     rep_ADD_SUBR(Smake_process);
2099     rep_ADD_SUBR(Sstart_process);
2100     rep_ADD_SUBR(Scall_process);
2101     rep_ADD_SUBR(Sinterrupt_process);
2102     rep_ADD_SUBR(Skill_process);
2103     rep_ADD_SUBR(Sstop_process);
2104     rep_ADD_SUBR(Scontinue_process);
2105     rep_ADD_SUBR(Ssignal_process);
2106     rep_ADD_SUBR(Sprocess_exit_status);
2107     rep_ADD_SUBR(Sprocess_exit_value);
2108     rep_ADD_SUBR(Sprocess_id);
2109     rep_ADD_SUBR(Sprocess_running_p);
2110     rep_ADD_SUBR(Sprocess_stopped_p);
2111     rep_ADD_SUBR(Sprocess_in_use_p);
2112     rep_ADD_SUBR(Sprocessp);
2113     rep_ADD_SUBR(Sprocess_prog);
2114     rep_ADD_SUBR(Sset_process_prog);
2115     rep_ADD_SUBR(Sprocess_args);
2116     rep_ADD_SUBR(Sset_process_args);
2117     rep_ADD_SUBR(Sprocess_output_stream);
2118     rep_ADD_SUBR(Sset_process_output_stream);
2119     rep_ADD_SUBR(Sprocess_error_stream);
2120     rep_ADD_SUBR(Sset_process_error_stream);
2121     rep_ADD_SUBR(Sprocess_function);
2122     rep_ADD_SUBR(Sset_process_function);
2123     rep_ADD_SUBR(Sprocess_dir);
2124     rep_ADD_SUBR(Sset_process_dir);
2125     rep_ADD_SUBR(Sprocess_connection_type);
2126     rep_ADD_SUBR(Sset_process_connection_type);
2127     rep_ADD_SUBR(Sactive_processes);
2128     rep_ADD_SUBR(Saccept_process_output);
2129     rep_ADD_SUBR(Saccept_process_output_1);
2130     rep_pop_structure (tem);
2131 
2132     process_type = rep_register_new_type ("subprocess", rep_ptr_cmp,
2133 					  proc_prin, proc_prin,
2134 					  proc_sweep, proc_mark,
2135 					  mark_active_processes,
2136 					  0, 0, proc_putc, proc_puts, 0, 0);
2137     rep_register_process_input_handler (read_from_process);
2138     rep_add_event_loop_callback (proc_periodically);
2139 }
2140 
2141 void
rep_proc_kill(void)2142 rep_proc_kill(void)
2143 {
2144     struct Proc *pr;
2145     signal(SIGCHLD, SIG_DFL);
2146     pr = process_chain;
2147     while(pr)
2148     {
2149 	struct Proc *nxt = pr->pr_Next;
2150 	kill_process(pr);
2151 	pr = nxt;
2152     }
2153     process_chain = NULL;
2154 }
2155