/* unix_processes.c -- Subprocess handling for Unix
Copyright (C) 1993, 1994 John Harper <john@dcs.warwick.ac.uk>
$Id: unix_processes.c,v 1.79 2003/10/28 22:29:39 jsh Exp $
This file is part of Jade.
Jade is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
Jade is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Jade; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#define _GNU_SOURCE
#include "repint.h"
/* Note that I have no idea how portable this code will be. It has
been tested under Solaris and Linux, but beyond that, I really don't
have the experience... */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <signal.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/socket.h>
#ifdef NEED_MEMORY_H
# include <memory.h>
#endif
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif
#ifdef HAVE_FCNTL_H
# include <fcntl.h>
#else
# include <sys/fcntl.h>
#endif
#ifdef HAVE_SYS_TIME_H
# include <sys/time.h>
#endif
#if HAVE_SYS_WAIT_H
# include <sys/wait.h>
#endif
#ifndef WEXITSTATUS
# define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
#endif
#ifndef WIFEXITED
# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
#endif
#ifdef HAVE_SYS_IOCTL_H
# include <sys/ioctl.h>
#endif
#ifdef HAVE_TERMIOS_H
# include <termios.h>
#endif
#ifdef HAVE_DEV_PTMX
# ifdef HAVE_STROPTS_H
# include <stropts.h>
# endif
#endif
#ifdef ENVIRON_UNDECLARED
extern char **environ;
#endif
void (*rep_sigchld_fun) (void) = 0;
static struct sigaction chld_sigact;
static sigset_t chld_sigset;
struct Proc
{
repv pr_Car; /* status in high bits */
struct Proc *pr_Next;
/* Chain of all processes waiting to be notified of a change of state. */
struct Proc *pr_NotifyNext;
pid_t pr_Pid;
/* pr_Stdin is where we write, pr_Stdout where we read, they may be the
same. pr_Stderr is only used with pipes--it may be a separate
connection to the stderr stream of the process. At all other times
it will be equal to pr_Stdout. */
int pr_Stdin, pr_Stdout, pr_Stderr;
repv pr_OutputStream, pr_ErrorStream;
int pr_ExitStatus;
repv pr_NotifyFun;
repv pr_Prog;
repv pr_Args;
repv pr_Dir;
repv pr_ConnType;
};
/* Status is two bits above the type code (presently 8->9) */
#define PR_ACTIVE (1 << (rep_CELL16_TYPE_BITS + 0)) /* active, may be stopped */
#define PR_STOPPED (2 << (rep_CELL16_TYPE_BITS + 1)) /* stopped */
#define PR_DEAD 0
#define PR_RUNNING PR_ACTIVE
#define PR_ACTIVE_P(p) ((p)->pr_Car & PR_ACTIVE)
#define PR_STOPPED_P(p) ((p)->pr_Car & PR_STOPPED)
#define PR_RUNNING_P(p) (PR_ACTIVE_P(p) && !PR_STOPPED_P(p))
#define PR_DEAD_P(p) !PR_ACTIVE_P(p)
#define PR_SET_STATUS(p,s) \
((p)->pr_Car = (((p)->pr_Car & ~(PR_ACTIVE | PR_STOPPED)) | (s)))
/* Connection types */
DEFSYM(pipe, "pipe");
DEFSYM(pty, "pty");
DEFSYM(socketpair, "socketpair");
#define PR_CONN_PTY_P(p) \
((p)->pr_ConnType == Qpty)
#define PR_CONN_PIPE_P(p) \
((p)->pr_ConnType == Qpipe)
#define PR_CONN_SOCKETPAIR_P(p) \
((p)->pr_ConnType == Qsocketpair)
#define VPROC(v) ((struct Proc *)rep_PTR(v))
#define PROCESSP(v) rep_CELL16_TYPEP(v, process_type)
/* Handy debugging macro */
#if 0
# define DB(x) fprintf x
#else
# define DB(x)
#endif
static struct Proc *process_chain;
static struct Proc *notify_chain;
static int process_run_count;
static int process_type;
/* Set to rep_TRUE by the SIGCHLD handler */
static volatile rep_bool got_sigchld;
static void read_from_one_fd(struct Proc *pr, int fd);
static void read_from_process(int);
DEFSTRING(not_running, "Not running");
DEFSTRING(not_stopped, "Not stopped");
DEFSTRING(no_link, "No link to input");
DEFSTRING(in_use, "Process in use");
DEFSTRING(no_pty, "Can't find unused pty");
DEFSTRING(already_running, "Already running");
DEFSTRING(no_prog, "No program");
DEFSTRING(cant_start, "Can't start");
DEFSTRING(dev_null, "/dev/null");
DEFSTRING(dot, ".");
DEFSTRING(not_local, "Need a local file");
DEFSTRING(forkstr, "fork");
DEFSTRING(nosig, "Unknown signal");
static RETSIGTYPE
sigchld_handler(int sig)
{
got_sigchld = rep_TRUE;
if (rep_sigchld_fun != 0)
(*rep_sigchld_fun) ();
}
static void
close_proc_files(struct Proc *pr)
{
if(pr->pr_Stdout)
{
rep_deregister_input_fd(pr->pr_Stdout);
close(pr->pr_Stdout);
}
if(pr->pr_Stderr && pr->pr_Stderr != pr->pr_Stdout)
{
rep_deregister_input_fd(pr->pr_Stderr);
close(pr->pr_Stderr);
}
if(pr->pr_Stdin && (pr->pr_Stdin != pr->pr_Stdout))
close(pr->pr_Stdin);
pr->pr_Stdout = pr->pr_Stdin = pr->pr_Stderr = 0;
}
/* PR's NotifyFun will be called when possible. This function is safe
to call from signal handlers. */
static void
queue_notify(struct Proc *pr)
{
if(pr->pr_NotifyNext == NULL)
{
pr->pr_NotifyNext = notify_chain;
notify_chain = pr;
}
}
/* Dispatch all queued notification. */
static rep_bool
proc_notification(void)
{
if(!notify_chain)
return(rep_FALSE);
while(notify_chain != NULL && !rep_INTERRUPTP)
{
struct Proc *pr = notify_chain;
notify_chain = pr->pr_NotifyNext;
pr->pr_NotifyNext = NULL;
if(pr->pr_NotifyFun && !rep_NILP(pr->pr_NotifyFun))
rep_call_lisp1(pr->pr_NotifyFun, rep_VAL(pr));
}
return rep_TRUE;
}
static inline rep_bool
notify_queued_p (struct Proc *pr)
{
return pr->pr_NotifyNext != 0;
}
static void
notify_1 (struct Proc *pr)
{
if (notify_queued_p (pr))
{
struct Proc **ptr = ¬ify_chain;
while (*ptr != pr)
ptr = &((*ptr)->pr_NotifyNext);
*ptr = pr->pr_NotifyNext;
pr->pr_NotifyNext = NULL;
if (pr->pr_NotifyFun && pr->pr_NotifyFun != Qnil)
rep_call_lisp1 (pr->pr_NotifyFun, rep_VAL (pr));
}
}
/* Checks if any of my children are zombies, takes appropriate action. */
static rep_bool
check_for_zombies(void)
{
if(!got_sigchld)
return rep_FALSE;
got_sigchld = rep_FALSE;
while(process_run_count > 0)
{
struct Proc *pr;
int status;
pid_t pid;
pid = waitpid(-1, &status, WNOHANG | WUNTRACED);
if(pid > 0)
{
/* Got a process id, find its process structure. */
for(pr = process_chain; pr != 0; pr = pr->pr_Next)
{
if(PR_ACTIVE_P(pr) && (pr->pr_Pid == pid))
{
/* Got it. */
#ifdef WIFSTOPPED
if(WIFSTOPPED(status))
{
/* Process is suspended. */
PR_SET_STATUS(pr, PR_ACTIVE | PR_STOPPED);
queue_notify(pr);
}
else
#endif
{
/* Process is dead. */
pr->pr_ExitStatus = status;
process_run_count--;
PR_SET_STATUS(pr, PR_DEAD);
/* Try to read any pending output */
if(pr->pr_Stdout)
read_from_one_fd(pr, pr->pr_Stdout);
if(pr->pr_Stderr && pr->pr_Stderr != pr->pr_Stdout)
read_from_one_fd(pr, pr->pr_Stderr);
/* Then close the streams */
close_proc_files(pr);
queue_notify(pr);
}
break;
}
}
}
else if(pid == 0)
break;
else if(pid < 0)
{
if(errno == EINTR)
continue;
else
break;
}
}
return rep_TRUE;
}
/* Called by the event loop after each event or timeout. Returns true
if the display should be updated. */
static rep_bool
proc_periodically(void)
{
rep_bool rc = check_for_zombies();
if(proc_notification())
rc = rep_TRUE;
return rc;
}
/* Read data from FD out of PROC. If necessary it will handle
clean up and notification. */
static void
read_from_one_fd(struct Proc *pr, int fd)
{
repv stream = ((fd != pr->pr_Stdout)
? pr->pr_ErrorStream : pr->pr_OutputStream);
u_char buf[1025];
int actual;
do {
if((actual = read(fd, buf, 1024)) > 0)
{
buf[actual] = 0;
if(!rep_NILP(stream))
rep_stream_puts(stream, buf, actual, rep_FALSE);
}
} while((actual > 0) || (actual < 0 && errno == EINTR));
if (actual == 0 || (actual < 0 && errno != EWOULDBLOCK && errno != EAGAIN))
{
/* We assume EOF */
rep_deregister_input_fd(fd);
close(fd);
/* Could be either pr_Stdout or pr_Stderr */
if(fd != pr->pr_Stdout)
pr->pr_Stderr = 0;
else
{
if(pr->pr_Stdin && (pr->pr_Stdin == pr->pr_Stdout))
pr->pr_Stdin = 0;
if(pr->pr_Stderr && (pr->pr_Stderr == pr->pr_Stdout))
pr->pr_Stderr = 0;
pr->pr_Stdout = 0;
}
}
}
static void
read_from_process(int fd)
{
struct Proc *pr;
pr = process_chain;
while(pr)
{
if(PR_ACTIVE_P(pr) && (pr->pr_Stdout == fd || pr->pr_Stderr == fd))
read_from_one_fd(pr, fd);
pr = pr->pr_Next;
}
}
static int
write_to_process(repv pr, u_char *buf, int bufLen)
{
int act = 0;
if(!PROCESSP(pr))
return(0);
if(PR_ACTIVE_P(VPROC(pr)))
{
if(VPROC(pr)->pr_Stdin == 0)
{
Fsignal(Qprocess_error, rep_list_2(pr, rep_VAL(&no_link)));
}
else
{
do {
/* This will block */
int this = write(VPROC(pr)->pr_Stdin, buf + act, bufLen - act);
if (this < 0)
{
if (errno != EINTR)
{
rep_signal_file_error(pr);
break;
}
}
else
act += this;
} while (act < bufLen);
}
}
else
Fsignal(Qprocess_error, rep_list_2(pr, rep_VAL(¬_running)));
return(act);
}
static rep_bool
signal_process(struct Proc *pr, int sig, rep_bool do_grp)
{
rep_bool rc = rep_TRUE;
if(do_grp)
{
if(pr->pr_Stdin && PR_CONN_PTY_P(pr))
{
pid_t gid = tcgetpgrp(pr->pr_Stdin);
if(gid != -1)
kill(-gid, sig);
else if(PR_ACTIVE_P(pr))
kill(-pr->pr_Pid, sig);
else
rc = rep_FALSE;
}
else
{
if(PR_ACTIVE_P(pr))
kill(-pr->pr_Pid, sig);
else
rc = rep_FALSE;
}
}
else
{
if(PR_ACTIVE_P(pr))
kill(pr->pr_Pid, sig);
else
rc = rep_FALSE;
}
return(rc);
}
/* This is only called during GC, when the process isn't being referenced.
it will already have been taken out of the chain. Also active processes
should have been marked anyway. */
static void
kill_process(struct Proc *pr)
{
if(PR_ACTIVE_P(pr))
{
/* is this too heavy-handed?? */
if(!signal_process(pr, SIGKILL, rep_TRUE))
kill(-pr->pr_Pid, SIGKILL);
waitpid(pr->pr_Pid, &pr->pr_ExitStatus, 0);
process_run_count--;
close_proc_files(pr);
}
rep_FREE_CELL(pr);
}
/* Return the file descriptor (or 0 if an error) of the first available
pty master. SLAVENAM will contain the name of the associated slave. */
static int
get_pty(char *slavenam)
{
#if defined(HAVE_PTYS)
char c;
int master;
# if defined(HAVE_DEV_PTMX) && defined(HAVE_GRANTPT)
master = open("/dev/ptmx", O_RDWR);
if(master >= 0)
{
char *tem;
grantpt(master);
unlockpt(master);
tem = ptsname(master);
if(tem != 0)
{
strcpy(slavenam, tem);
return master;
}
close(master);
}
# endif
# if defined(FIRST_PTY_LETTER)
/* Assume /dev/ptyXNN and /dev/ttyXN naming system.
The FIRST_PTY_LETTER gives the first X to try. We try in the
sequence FIRST_PTY_LETTER, .., 'z', 'a', .., FIRST_PTY_LETTER.
Is this worthwhile, or just over-zealous? */
c = FIRST_PTY_LETTER;
do {
int i;
for(i = 0; i < 16; i++)
{
struct stat statb;
sprintf(slavenam, "/dev/pty%c%x", c, i);
if(stat(slavenam, &statb) < 0)
goto none;
if((master = open(slavenam, O_RDWR)) >= 0)
{
slavenam[sizeof("/dev/")-1] = 't';
if(access(slavenam, R_OK | W_OK) == 0)
return master;
close(master);
}
}
if(++c > 'z')
c = 'a';
} while(c != FIRST_PTY_LETTER);
none:
# endif /* FIRST_PTY_LETTER */
#endif /* HAVE_PTYS */
/* Couldn't find a pty. Signal an error. */
Fsignal(Qprocess_error, rep_LIST_1(rep_VAL(&no_pty)));
return 0;
}
static void
child_build_environ (void)
{
/* Build the environment */
repv tem = Fsymbol_value(Qprocess_environment, Qt);
if(rep_CONSP(tem))
{
repv len = Flength(tem);
if(len && rep_INTP(len))
{
environ = rep_alloc(sizeof(char *) * (rep_INT(len) + 1));
if(environ != 0)
{
char **ptr = environ;
while(rep_CONSP(tem))
{
*ptr++ = rep_STR(rep_CAR(tem));
tem = rep_CDR(tem);
}
*ptr++ = 0;
}
}
}
}
/* does the dirty stuff of getting the process running. if SYNC_INPUT
is non-NULL it means to run the process synchronously with it's
stdin connected to the file SYNC_INPUT. Otherwise this function returns
immediately after starting the process. */
static rep_bool
run_process(struct Proc *pr, char **argv, u_char *sync_input)
{
rep_bool rc = rep_FALSE;
if(PR_DEAD_P(pr))
{
rep_bool usepty = PR_CONN_PTY_P(pr);
char slavenam[32];
int stdin_fds[2], stdout_fds[2], stderr_fds[2]; /* only for pipes */
pr->pr_ExitStatus = -1;
if(sync_input != NULL || !usepty)
{
usepty = rep_FALSE;
pr->pr_ConnType = Qpipe;
if(pipe(stdout_fds) == 0)
{
if(pipe(stderr_fds) == 0)
{
if(sync_input)
{
stdin_fds[0] = open(sync_input, O_RDONLY);
if(stdin_fds[0] >= 0)
pr->pr_Stdin = stdin_fds[0]; /* fake */
}
else
{
if(pipe(stdin_fds) == 0)
pr->pr_Stdin = stdin_fds[1];
}
if(pr->pr_Stdin != 0)
{
pr->pr_Stdout = stdout_fds[0];
pr->pr_Stderr = stderr_fds[0];
}
else
{
close(stderr_fds[0]);
close(stderr_fds[1]);
}
}
else
{
close(stdout_fds[0]);
close(stdout_fds[1]);
}
}
}
else if (PR_CONN_SOCKETPAIR_P(pr))
{
/* XXX separate stdout from stderr.. */
if (socketpair (AF_UNIX, SOCK_STREAM, 0, stdin_fds) == 0)
{
pr->pr_Stdin = stdin_fds[0];
pr->pr_Stdout = stdin_fds[0];
pr->pr_Stderr = stdin_fds[0];
}
}
else if(usepty)
{
pr->pr_Stdin = get_pty(slavenam);
pr->pr_Stdout = pr->pr_Stdin;
pr->pr_Stderr = pr->pr_Stdin;
}
if(pr->pr_Stdin)
{
int pty_slave_fd = -1;
/* Must set up pty slave before forking, to avoid race
condition if master writes to it first */
if(usepty)
{
struct termios st;
pty_slave_fd = open(slavenam, O_RDWR);
if (pty_slave_fd >= 0)
{
#ifdef HAVE_DEV_PTMX
# ifdef I_PUSH
/* Push the necessary modules onto the slave to
get terminal semantics. */
ioctl(pty_slave_fd, I_PUSH, "ptem");
ioctl(pty_slave_fd, I_PUSH, "ldterm");
# endif
#endif
#ifdef TIOCSCTTY
ioctl(pty_slave_fd, TIOCSCTTY, 0);
#endif
tcgetattr(pty_slave_fd, &st);
st.c_iflag &= ~(ISTRIP | IGNCR | INLCR | IXOFF);
st.c_iflag |= (ICRNL | IGNPAR | BRKINT | IXON);
st.c_oflag &= ~OPOST;
st.c_cflag &= ~CSIZE;
st.c_cflag |= CREAD | CS8 | CLOCAL;
st.c_lflag &= ~(ECHO | ECHOE | ECHOK | NOFLSH | TOSTOP);
st.c_lflag |= ISIG;
#if 0
st.c_cc[VMIN] = 1;
st.c_cc[VTIME] = 0;
#endif
/* Set some control codes to default values */
st.c_cc[VINTR] = '\003'; /* ^c */
st.c_cc[VQUIT] = '\034'; /* ^| */
st.c_cc[VERASE] = '\177'; /* ^? */
st.c_cc[VKILL] = '\025'; /* ^u */
st.c_cc[VEOF] = '\004'; /* ^d */
tcsetattr(pty_slave_fd, TCSANOW, &st);
}
}
switch(pr->pr_Pid = fork())
{
case 0:
/* Child process */
child_build_environ ();
if(usepty)
{
if(setsid() < 0)
{
perror("child: setsid()");
_exit(255);
}
if(pty_slave_fd < 0)
{
perror("child: open(slave)");
_exit(255);
}
close(pr->pr_Stdin);
dup2(pty_slave_fd, 0);
dup2(pty_slave_fd, 1);
dup2(pty_slave_fd, 2);
if(pty_slave_fd > 2)
{
close(pty_slave_fd);
pty_slave_fd = -1;
}
}
else if (PR_CONN_SOCKETPAIR_P(pr))
{
/* startup for socketpair */
if(setpgid(0, 0) != 0)
{
perror("setpgid");
_exit(255);
}
close (stdin_fds[0]);
dup2 (stdin_fds[1], 0);
dup2 (stdin_fds[1], 1);
dup2 (stdin_fds[1], 2);
close (stdin_fds[1]);
}
else
{
/* startup for pipes */
if(setpgid(0, 0) != 0)
{
perror("setpgid");
_exit(255);
}
dup2(stdin_fds[0], 0);
close(stdin_fds[0]);
if(sync_input == NULL)
close(stdin_fds[1]);
dup2(stdout_fds[1], 1);
dup2(stderr_fds[1], 2);
close(stdout_fds[0]);
close(stdout_fds[1]);
close(stderr_fds[0]);
close(stderr_fds[1]);
}
if(rep_STRINGP(pr->pr_Dir))
{
if(rep_STRING_LEN(pr->pr_Dir) > 0)
chdir(rep_STR(pr->pr_Dir));
}
signal (SIGPIPE, SIG_DFL);
execvp(argv[0], argv);
perror("child subprocess can't exec");
_exit(255);
case -1:
/* Clean up all open files */
if (pty_slave_fd != -1)
close (pty_slave_fd);
if (PR_CONN_SOCKETPAIR_P(pr))
{
close (stdin_fds[0]);
close (stdin_fds[1]);
}
if (sync_input != 0 || !usepty)
{
/* pipes */
close(stdout_fds[0]); close(stdout_fds[1]);
close(stderr_fds[0]); close(stderr_fds[1]);
close(stdin_fds[0]);
if (sync_input != 0)
close(stdin_fds[1]);
}
else
close(pr->pr_Stdin);
pr->pr_Stdin = pr->pr_Stdout = pr->pr_Stderr = 0;
rep_signal_file_error(rep_VAL(&forkstr));
break;
default:
/* Parent process */
if (pty_slave_fd != -1)
close (pty_slave_fd);
PR_SET_STATUS(pr, PR_RUNNING);
if (PR_CONN_SOCKETPAIR_P(pr))
{
close (stdin_fds[1]);
}
else if(!usepty)
{
close(stdin_fds[0]);
close(stdout_fds[1]);
close(stderr_fds[1]);
}
if(sync_input == NULL)
{
if(pr->pr_Stdin == pr->pr_Stdout)
{
/* So that pr_Stdout can be made non-blocking
set up another fd for writing to. */
if((pr->pr_Stdin = dup(pr->pr_Stdout)) < 0)
{
/* Maybe this is unwise? */
perror("dup(pr->pr_Stdout)");
pr->pr_Stdin = pr->pr_Stdout;
}
}
rep_unix_set_fd_cloexec(pr->pr_Stdin);
rep_unix_set_fd_nonblocking(pr->pr_Stdout);
rep_register_input_fd(pr->pr_Stdout, read_from_process);
if(pr->pr_Stderr != pr->pr_Stdout)
{
rep_unix_set_fd_nonblocking(pr->pr_Stderr);
rep_register_input_fd(pr->pr_Stderr,
read_from_process);
}
process_run_count++;
}
else
{
/* Run synchronously. */
u_char buf[1025];
int actual;
fd_set inputs;
rep_bool done_out = rep_FALSE, done_err = rep_FALSE;
rep_bool exited = rep_FALSE;
int interrupt_count = 0;
#ifdef KLUDGE_SYNCHRONOUS_OUTPUT
int post_exit_count = 0;
#endif
FD_ZERO(&inputs);
FD_SET(pr->pr_Stdout, &inputs);
FD_SET(pr->pr_Stderr, &inputs);
pr->pr_Stdin = 0;
fcntl(pr->pr_Stdout, F_SETFL, O_NONBLOCK);
fcntl(pr->pr_Stderr, F_SETFL, O_NONBLOCK);
while(!(done_out && done_err))
{
fd_set copy = inputs;
struct timeval timeout;
int number;
timeout.tv_sec = 1;
timeout.tv_usec = 0;
rep_sig_restart(SIGCHLD, rep_FALSE);
number = select(FD_SETSIZE, ©, NULL,
NULL, &timeout);
rep_sig_restart(SIGCHLD, rep_TRUE);
rep_TEST_INT_SLOW;
if(rep_INTERRUPTP)
{
int signal;
/* What to do here? */
switch(++interrupt_count)
{
case 1:
signal = SIGINT;
break;
case 2:
signal = SIGTERM;
break;
default:
signal = SIGKILL;
}
signal_process(pr, signal, rep_TRUE);
if(rep_throw_value == rep_int_cell)
rep_throw_value = 0;
}
if(number > 0)
{
rep_GC_root gc_pr;
repv vpr = rep_VAL(pr);
rep_PUSHGC(gc_pr, vpr);
if(!done_out && FD_ISSET(pr->pr_Stdout, ©))
{
actual = read(pr->pr_Stdout, buf, 1024);
if(actual > 0)
{
buf[actual] = 0;
if(!rep_NILP(pr->pr_OutputStream))
{
rep_stream_puts(pr->pr_OutputStream, buf,
actual, rep_FALSE);
}
}
else if(actual == 0
|| (errno != EINTR
&& errno != EAGAIN
&& errno != EWOULDBLOCK))
{
done_out = rep_TRUE;
FD_CLR(pr->pr_Stdout, &inputs);
}
}
if(!done_err && FD_ISSET(pr->pr_Stderr, ©))
{
actual = read(pr->pr_Stderr, buf, 1024);
if(actual > 0)
{
buf[actual] = 0;
if(!rep_NILP(pr->pr_ErrorStream))
{
rep_stream_puts(pr->pr_ErrorStream, buf,
actual, rep_FALSE);
}
}
else if(actual == 0
|| (errno != EINTR
&& errno != EAGAIN
&& errno != EWOULDBLOCK))
{
done_err = rep_TRUE;
FD_CLR(pr->pr_Stderr, &inputs);
}
}
rep_POPGC;
}
#ifdef KLUDGE_SYNCHRONOUS_OUTPUT
/* This still doesn't work. The best way to
solve this problem is to move the onus to
the caller. If a command is called which
spawns on its streams, they should be
redirected somewhere safe beforehand. */
/* The next two statements are a bit kludgey.
Problem: If the child process exits, but has
spawned an orphan of its own on the same input
and output streams, the done_out and done_err
flags won't get set until the _orphan_ quits.
Solution: Check for process exit here. If it
has exited, allow a few more timeouts, before
breaking the loop. */
if(exited && number == 0 && ++post_exit_count > 2)
break;
if(!exited && got_sigchld
&& waitpid(pr->pr_Pid,
&pr->pr_ExitStatus,
WNOHANG) == pr->pr_Pid)
exited = rep_TRUE;
#endif
}
if(!exited)
waitpid(pr->pr_Pid, &pr->pr_ExitStatus, 0);
close(pr->pr_Stdout);
close(pr->pr_Stderr);
pr->pr_Stdout = 0;
pr->pr_Stderr = 0;
PR_SET_STATUS(pr, PR_DEAD);
queue_notify(pr);
}
rc = rep_TRUE;
break;
}
}
else if(rep_throw_value == rep_NULL)
Fsignal(Qprocess_error, rep_LIST_1(rep_lookup_errno()));
}
else
Fsignal(Qprocess_error, rep_list_2(rep_VAL(pr), rep_VAL(&already_running)));
return(rc);
}
static void
proc_mark(repv pr)
{
rep_MARKVAL(VPROC(pr)->pr_OutputStream);
rep_MARKVAL(VPROC(pr)->pr_ErrorStream);
rep_MARKVAL(VPROC(pr)->pr_NotifyFun);
rep_MARKVAL(VPROC(pr)->pr_Prog);
rep_MARKVAL(VPROC(pr)->pr_Args);
rep_MARKVAL(VPROC(pr)->pr_Dir);
rep_MARKVAL(VPROC(pr)->pr_ConnType);
}
static void
mark_active_processes(void)
{
struct Proc *pr = process_chain;
while(pr != 0)
{
if(PR_ACTIVE_P(pr))
rep_MARKVAL(rep_VAL(pr));
pr = pr->pr_Next;
}
}
static void
proc_sweep(void)
{
struct Proc *pr;
/* First weed out any unused processes from the notify chain... */
pr = notify_chain;
notify_chain = NULL;
while(pr)
{
if(rep_GC_CELL_MARKEDP(rep_VAL(pr)))
{
pr->pr_NotifyNext = notify_chain;
notify_chain = pr;
}
pr = pr->pr_NotifyNext;
}
/* ...then do the normal sweep stuff. */
pr = process_chain;
process_chain = NULL;
while(pr)
{
struct Proc *nxt = pr->pr_Next;
if(!rep_GC_CELL_MARKEDP(rep_VAL(pr)))
kill_process(pr);
else
{
rep_GC_CLR_CELL(rep_VAL(pr));
pr->pr_Next = process_chain;
process_chain = pr;
}
pr = nxt;
}
}
static void
proc_prin(repv strm, repv obj)
{
struct Proc *pr = VPROC(obj);
u_char buf[40];
rep_stream_puts(strm, "#<process", -1, rep_FALSE);
if(PR_RUNNING_P(pr))
{
rep_stream_puts(strm, " running: ", -1, rep_FALSE);
rep_stream_puts(strm, rep_PTR(pr->pr_Prog), -1, rep_TRUE);
}
else if(PR_STOPPED_P(pr))
{
rep_stream_puts(strm, " stopped: ", -1, rep_FALSE);
rep_stream_puts(strm, rep_PTR(pr->pr_Prog), -1, rep_TRUE);
}
else
{
if(pr->pr_ExitStatus != -1)
{
#ifdef HAVE_SNPRINTF
snprintf(buf, sizeof(buf), " exited: 0x%x", pr->pr_ExitStatus);
#else
sprintf(buf, " exited: 0x%x", pr->pr_ExitStatus);
#endif
rep_stream_puts(strm, buf, -1, rep_FALSE);
}
}
rep_stream_putc(strm, '>');
}
static int
proc_putc(repv stream, int c)
{
char tmps[2];
tmps[0] = (u_char)c;
tmps[1] = 0;
return write_to_process(stream, tmps, 1);
}
static int
proc_puts(repv stream, void *data, int len, rep_bool is_lisp)
{
u_char *buf = is_lisp ? rep_STR(data) : data;
return write_to_process(stream, buf, len);
}
DEFUN("make-process", Fmake_process, Smake_process, (repv stream, repv fun, repv dir, repv prog, repv args), rep_Subr5) /*
::doc:rep.io.processes#make-process::
make-process [OUTPUT-STREAM] [FUN] [DIR] [PROGRAM] [ARGS]
Creates a new process-object, OUTPUT-STREAM is where all output from this
process goes, both stdout and stderr, FUN is a function to call each time
the process running on this object changes state. DIR is the process'
current directory, PROGRAM the filename of the program to run and ARGS a
list of arguments passed to the process.
Any of the arguments may be unspecified, in which case they can be set
either by the functions provided or by the function called to create the
actual running process.
If the DIR parameter is nil it will be inherited from the
`default-directory' variable of the current buffer.
::end:: */
{
repv pr = rep_VAL(rep_ALLOC_CELL(sizeof(struct Proc)));
if(pr != rep_NULL)
{
rep_GC_root gc_pr;
rep_data_after_gc += sizeof (struct Proc);
VPROC(pr)->pr_Car = process_type;
VPROC(pr)->pr_Next = process_chain;
process_chain = VPROC(pr);
VPROC(pr)->pr_NotifyNext = NULL;
PR_SET_STATUS(VPROC(pr), PR_DEAD);
VPROC(pr)->pr_Pid = 0;
VPROC(pr)->pr_Stdin = VPROC(pr)->pr_Stdout = 0;
VPROC(pr)->pr_ExitStatus = -1;
VPROC(pr)->pr_OutputStream = stream;
VPROC(pr)->pr_ErrorStream = stream;
VPROC(pr)->pr_NotifyFun = fun;
VPROC(pr)->pr_Prog = prog;
VPROC(pr)->pr_Args = args;
VPROC(pr)->pr_ConnType = Qpipe;
VPROC(pr)->pr_Dir = dir;
/* Ensure that pr_Dir refers to an absolute local file */
rep_PUSHGC(gc_pr, pr);
dir = Flocal_file_name(rep_STRINGP(dir) ? dir : rep_VAL(&dot));
rep_POPGC;
if(dir && rep_STRINGP(dir))
VPROC(pr)->pr_Dir = dir;
else
VPROC(pr)->pr_Dir = Qnil;
return pr;
}
else
return rep_mem_error();
}
DEFUN("start-process", Fstart_process, Sstart_process, (repv arg_list), rep_SubrN) /*
::doc:rep.io.processes#start-process::
start-process [PROCESS] [PROGRAM] [ARGS...]
Starts a process running on process-object PROCESS. The child-process runs
asynchronously with the editor. If PROCESS is unspecified the make-process
function will be called (with zero arguments) to create one.
PROGRAM is the filename of the binary image, it will be searched for in
all directories listed in the `PATH' environment variable.
ARGS are the arguments to give to the process.
If any of the optional parameters are unspecified they should have been
set in the PROCESS prior to calling this function.
::end:: */
{
struct Proc *pr = NULL;
repv res = Qnil;
if(rep_CONSP(arg_list))
{
if(PROCESSP(rep_CAR(arg_list)))
pr = VPROC(rep_CAR(arg_list));
arg_list = rep_CDR(arg_list);
}
if(pr == NULL)
{
pr = VPROC(Fmake_process(Qnil, Qnil, Qnil,
Qnil, Qnil));
if(pr == NULL)
return rep_NULL;
}
if(rep_CONSP(arg_list))
{
if(rep_STRINGP(rep_CAR(arg_list)))
pr->pr_Prog = rep_CAR(arg_list);
arg_list = rep_CDR(arg_list);
if(rep_CONSP(arg_list))
pr->pr_Args = arg_list;
}
if(!rep_STRINGP(pr->pr_Prog))
{
res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&no_prog), rep_VAL(pr)));
}
else
{
int numargs = rep_list_length(pr->pr_Args) + 1;
char **argv = rep_alloc(sizeof(char *) * (numargs + 1));
if(argv)
{
int i;
arg_list = pr->pr_Args;
argv[0] = rep_STR(pr->pr_Prog);
for(i = 1; i < numargs; i++)
{
if(rep_STRINGP(rep_CAR(arg_list)))
argv[i] = rep_STR(rep_CAR(arg_list));
else
argv[i] = "";
arg_list = rep_CDR(arg_list);
}
argv[i] = NULL;
if(run_process(pr, argv, NULL))
res = rep_VAL(pr);
else
{
res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&cant_start),
rep_VAL(pr)));
}
rep_free(argv);
}
}
return(res);
}
DEFUN("call-process", Fcall_process, Scall_process, (repv arg_list), rep_SubrN) /*
::doc:rep.io.processes#call-process::
call-process [PROCESS] [IN-FILE] [PROGRAM] [ARGS...]
Starts a process running on process-object PROCESS. Waits for the child to
exit, then returns the exit-value of the child. If PROCESS is unspecified
the make-process function will be called (with zero arguments) to create one.
IN-FILE is the name of the file to connect to the process' standard input,
if this is not defined `/dev/null' is used.
PROGRAM is the filename of the binary image, it will be searched for in
all directories listed in the `PATH' environment variable.
ARGS are the arguments to give to the process.
If any of the optional parameters are unspecified they should have been
set in the PROCESS prior to calling this function.
::end:: */
{
struct Proc *pr = NULL;
repv res = Qnil, infile = rep_VAL(&dev_null);
if(rep_CONSP(arg_list))
{
if(PROCESSP(rep_CAR(arg_list)))
pr = VPROC(rep_CAR(arg_list));
arg_list = rep_CDR(arg_list);
}
if(pr == NULL)
{
pr = VPROC(Fmake_process(Qnil, Qnil, Qnil,
Qnil, Qnil));
if(pr == NULL)
return rep_NULL;
}
if(rep_CONSP(arg_list))
{
if(rep_STRINGP(rep_CAR(arg_list)))
infile = rep_CAR(arg_list);
arg_list = rep_CDR(arg_list);
if(rep_CONSP(arg_list))
{
if(rep_STRINGP(rep_CAR(arg_list)))
pr->pr_Prog = rep_CAR(arg_list);
arg_list = rep_CDR(arg_list);
if(rep_CONSP(arg_list))
pr->pr_Args = arg_list;
}
}
if(infile != rep_VAL(&dev_null))
{
/* Ensure that INFILE is a real name in the local file
system, and that the file actually exists. */
rep_GC_root gc_arg_list, gc_pr, gc_infile;
repv _pr = rep_VAL(pr);
rep_PUSHGC(gc_arg_list, arg_list);
rep_PUSHGC(gc_pr, _pr);
rep_PUSHGC(gc_infile, infile);
infile = Flocal_file_name(infile);
if(infile && rep_STRINGP(infile))
{
if(rep_NILP(rep_file_exists_p(infile)))
res = rep_signal_file_error(infile);
}
else
res = Fsignal(Qprocess_error,
rep_LIST_2(rep_VAL(¬_local), rep_VAL(pr)));
rep_POPGC; rep_POPGC; rep_POPGC;
}
if(rep_NILP(res) && !rep_STRINGP(pr->pr_Prog))
res = Fsignal(Qprocess_error, rep_LIST_2(rep_VAL(&no_prog), rep_VAL(pr)));
if(rep_NILP(res))
{
int numargs = rep_list_length(pr->pr_Args) + 1;
char **argv = rep_alloc(sizeof(char *) * (numargs + 1));
if(argv)
{
int i;
arg_list = pr->pr_Args;
argv[0] = rep_STR(pr->pr_Prog);
for(i = 1; i < numargs; i++)
{
if(rep_STRINGP(rep_CAR(arg_list)))
argv[i] = rep_STR(rep_CAR(arg_list));
else
argv[i] = "";
arg_list = rep_CDR(arg_list);
}
argv[i] = NULL;
if(run_process(pr, argv, rep_STR(infile)))
res = rep_MAKE_INT(pr->pr_ExitStatus);
else
{
res = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&cant_start),
rep_VAL(pr)));
}
rep_free(argv);
}
}
return(res);
}
/* If PROC is running asynchronously then send signal number SIGNAL
to it. If SIGNAL-GROUP is non-nil send the signal to all processes
in the process group of PROC. Returns t if successful. */
static repv
do_signal_command(repv proc, int signal, repv signal_group)
{
repv res = Qnil;
rep_DECLARE1(proc, PROCESSP);
if(PR_ACTIVE_P(VPROC(proc)))
{
if(signal_process(VPROC(proc), signal, !rep_NILP(signal_group)))
res = Qt;
}
else
{
res = Fsignal(Qprocess_error, rep_list_2(proc, rep_VAL(¬_running)));
}
return res;
}
DEFUN("interrupt-process", Finterrupt_process, Sinterrupt_process, (repv proc, repv grp), rep_Subr2) /*
::doc:rep.io.processes#interrupt-process::
interrupt-process PROCESS [SIGNAL-GROUP]
Interrupt the asynchronous process PROCESS. If SIGNAL-GROUP is t, interrupt
all child processes of PROCESS (it's process group).
::end:: */
{
return do_signal_command(proc, SIGINT, grp);
}
DEFUN("kill-process", Fkill_process, Skill_process, (repv proc, repv grp), rep_Subr2) /*
::doc:rep.io.processes#kill-process::
kill-process PROCESS [SIGNAL-GROUP]
Kill the asynchronous process PROCESS. If SIGNAL-GROUP is t, kill all
child processes of PROCESS (it's process group).
::end:: */
{
return do_signal_command(proc, SIGKILL, grp);
}
DEFUN("stop-process", Fstop_process, Sstop_process, (repv proc, repv grp), rep_Subr2) /*
::doc:rep.io.processes#stop-process::
stop-process PROCESS [SIGNAL-GROUP]
Suspends execution of PROCESS, see `continue-process'. If SIGNAL-GROUP is
non-nil also suspends the processes in the process group of PROCESS.
::end:: */
{
return do_signal_command(proc, SIGSTOP, grp);
}
DEFUN("continue-process", Fcontinue_process, Scontinue_process, (repv proc, repv grp), rep_Subr2) /*
::doc:rep.io.processes#continue-process::
continue-process PROCESS [SIGNAL-GROUP]
Restarts PROCESS after it has been stopped (via `stop-process'). If
SIGNAL-GROUP is non-nil also continues the processes in the process group of
PROCESS.
::end:: */
{
repv res = Qt;
rep_DECLARE1(proc, PROCESSP);
if(PR_STOPPED_P(VPROC(proc)))
{
if(signal_process(VPROC(proc), SIGCONT, !rep_NILP(grp)))
{
PR_SET_STATUS(VPROC(proc), PR_RUNNING);
res = Qt;
queue_notify(VPROC(proc));
}
}
else
{
res = Fsignal(Qprocess_error, rep_list_2(proc, rep_VAL(¬_stopped)));
}
return(res);
}
DEFUN("signal-process", Fsignal_process, Ssignal_process,
(repv proc, repv sig, repv grp), rep_Subr3) /*
::doc:rep.io.processes#signal_process::
signal-process PROCESS SIGNAL [SIGNAL-GROUP]
Sends the signal SIGNAL to the process PROCESS. If SIGNAL-GROUP is
non-nil also continues the processes in the process group of PROCESS.
PROCESS may be either a Lisp process object, or an integer giving the
process-id of a process (not necessarily started by rep).
SIGNAL may either be a numeric signal, or a symbol naming a signal, i.e.
the symbol `INT' for the UNIX SIGINT signal.
::end:: */
{
static const struct {
const char *name;
int sig;
} signals[] = {
#ifdef SIGFPE
{ "FPE", SIGFPE },
#endif
#ifdef SIGILL
{ "ILL", SIGILL },
#endif
#ifdef SIGSEGV
{ "SEGV", SIGSEGV },
#endif
#ifdef SIGBUS
{ "BUS", SIGBUS },
#endif
#ifdef SIGABRT
{ "ABRT", SIGABRT },
#endif
#ifdef SIGIOT
{ "IOT", SIGIOT },
#endif
#ifdef SIGTRAP
{ "TRAP", SIGTRAP },
#endif
#ifdef SIGEMT
{ "EMT", SIGEMT },
#endif
#ifdef SIGSYS
{ "SYS", SIGSYS },
#endif
#ifdef SIGTERM
{ "TERM", SIGTERM },
#endif
#ifdef SIGINT
{ "INT", SIGINT },
#endif
#ifdef SIGQUIT
{ "QUIT", SIGQUIT },
#endif
#ifdef SIGKILL
{ "KILL", SIGKILL },
#endif
#ifdef SIGHUP
{ "HUP", SIGHUP },
#endif
#ifdef SIGALRM
{ "ALRM", SIGALRM },
#endif
#ifdef SIGVTALRM
{ "VTALRM", SIGVTALRM },
#endif
#ifdef SIGPROF
{ "PROF", SIGPROF },
#endif
#ifdef SIGIO
{ "IO", SIGIO },
#endif
#ifdef SIGURG
{ "URG", SIGURG },
#endif
#ifdef SIGPOLL
{ "POLL", SIGPOLL },
#endif
#ifdef SIGCHLD
{ "CHLD", SIGCHLD }, { "CLD", SIGCHLD },
#endif
#ifdef SIGCONT
{ "CONT", SIGCONT },
#endif
#ifdef SIGSTOP
{ "STOP", SIGSTOP },
#endif
#ifdef SIGTSTP
{ "TSTP", SIGTSTP },
#endif
#ifdef SIGTTIN
{ "TTIN", SIGTTIN },
#endif
#ifdef SIGTTOU
{ "TTOU", SIGTTOU },
#endif
#ifdef SIGPIPE
{ "PIPE", SIGPIPE },
#endif
#ifdef SIGLOST
{ "LOST", SIGLOST },
#endif
#ifdef SIGXCPU
{ "XCPU", SIGXCPU },
#endif
#ifdef SIGXFSZ
{ "XFSZ", SIGXFSZ },
#endif
#ifdef SIGUSR1
{ "USR1", SIGUSR1 },
#endif
#ifdef SIGUSR2
{ "USR2", SIGUSR2 },
#endif
#ifdef SIGWINCH
{ "WINCH", SIGWINCH },
#endif
#ifdef SIGINFO
{ "INFO", SIGINFO },
#endif
{ 0 }
};
int signal = -1;
rep_DECLARE(1, proc, PROCESSP(proc) || rep_INTP(proc));
rep_DECLARE(2, sig, rep_INTP(sig) || rep_SYMBOLP(sig));
if (rep_INTP(sig))
signal = rep_INT(sig);
else
{
char *s = rep_STR(rep_SYM(sig)->name);
int i;
for (i = 0; signals[i].name != 0; i++)
{
if (strcmp (s, signals[i].name) == 0)
{
signal = signals[i].sig;
break;
}
}
if (signal == -1)
return Fsignal (Qerror, rep_list_2 (rep_VAL(&nosig), sig));
}
if (rep_INTP(proc) && rep_INT(proc) > 0)
{
struct Proc *pr = process_chain;
while (pr != 0 && pr->pr_Pid != rep_INT(proc))
pr = pr->pr_Next;
if (pr != 0)
proc = rep_VAL(pr);
}
if (PROCESSP(proc))
return do_signal_command (proc, signal, grp);
else
{
int r;
if (grp != Qnil)
r = kill (- rep_INT(proc), signal);
else
r = kill (rep_INT(proc), signal);
return (r == 0) ? Qt : Qnil;
}
}
DEFUN("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-exit-status::
process-exit-status PROCESS
Returns the unprocessed exit-status of the last process to be run on the
process-object PROCESS. If PROCESS is currently running, return nil.
::end:: */
{
repv res = Qnil;
rep_DECLARE1(proc, PROCESSP);
if(PR_DEAD_P(VPROC(proc)))
{
if(VPROC(proc)->pr_ExitStatus != -1)
res = rep_MAKE_INT(VPROC(proc)->pr_ExitStatus);
}
return(res);
}
DEFUN("process-exit-value", Fprocess_exit_value, Sprocess_exit_value, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-exit-value::
process-exit-value PROCESS
Returns the return-value of the last process to be run on PROCESS, or nil if:
a) no process has run on PROCESS
b) PROCESS is still running
c) PROCESS exited abnormally
::end:: */
{
repv res = Qnil;
rep_DECLARE1(proc, PROCESSP);
if((PR_DEAD_P(VPROC(proc)))
&& (VPROC(proc)->pr_ExitStatus != -1))
res = rep_MAKE_INT(WEXITSTATUS(VPROC(proc)->pr_ExitStatus));
return(res);
}
DEFUN("process-id", Fprocess_id, Sprocess_id, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-id::
process-id [PROCESS]
If PROCESS is running or stopped, return the process-identifier associated
with it (ie, its pid).
If PROCESS is nil, return the process id of the Lisp interpreter.
::end:: */
{
if (proc == Qnil)
return rep_MAKE_INT(getpid ());
else
{
repv res = Qnil;
rep_DECLARE1(proc, PROCESSP);
if(PR_ACTIVE_P(VPROC(proc)))
res = rep_MAKE_INT(VPROC(proc)->pr_Pid);
return(res);
}
}
DEFUN("process-running-p", Fprocess_running_p, Sprocess_running_p, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-running-p::
process-running-p PROCESS
Return t if PROCESS is running.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
if(PR_RUNNING_P(VPROC(proc)))
res = Qt;
else
res = Qnil;
return(res);
}
DEFUN("process-stopped-p", Fprocess_stopped_p, Sprocess_stopped_p, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-stopped-p::
process-stopped-p PROCESS
Return t if PROCESS has been stopped.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
if(PR_STOPPED_P(VPROC(proc)))
res = Qt;
else
res = Qnil;
return(res);
}
DEFUN("process-in-use-p", Fprocess_in_use_p, Sprocess_in_use_p, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-in-use-p::
process-in-use-p PROCESS
Similar to `process-running-p' except that this returns t even when the
process has stopped.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
if(PR_ACTIVE_P(VPROC(proc)))
res = Qt;
else
res = Qnil;
return(res);
}
DEFUN("processp", Fprocessp, Sprocessp, (repv arg), rep_Subr1) /*
::doc:rep.io.processes#process-p::
processp ARG
Return t is ARG is a process-object.
::end:: */
{
if(PROCESSP(arg))
return(Qt);
return(Qnil);
}
DEFUN("process-prog", Fprocess_prog, Sprocess_prog, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-prog::
process-prog PROCESS
Return the name of the program in PROCESS.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_Prog;
return(res);
}
DEFUN("set-process-prog", Fset_process_prog, Sset_process_prog, (repv proc, repv prog), rep_Subr2) /*
::doc:rep.io.processes#set-process-prog::
set-process-prog PROCESS PROGRAM
Sets the name of the program to run on PROCESS to FILE.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
rep_DECLARE2(prog, rep_STRINGP);
VPROC(proc)->pr_Prog = prog;
return(prog);
}
DEFUN("process-args", Fprocess_args, Sprocess_args, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-args::
process-args PROCESS
Return the list of arguments to PROCESS.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_Args;
return(res);
}
DEFUN("set-process-args", Fset_process_args, Sset_process_args, (repv proc, repv args), rep_Subr2) /*
::doc:rep.io.processes#set-process-args::
set-process-args PROCESS ARG-LIST
Set the arguments to PROCESS.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
if(!rep_NILP(args) && !rep_CONSP(args))
return(rep_signal_arg_error(args, 2));
VPROC(proc)->pr_Args = args;
return(args);
}
DEFUN("process-output-stream", Fprocess_output_stream, Sprocess_output_stream, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-output-stream::
process-output-stream PROCESS
Return the stream to which all output from PROCESS is sent.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_OutputStream;
return(res);
}
DEFUN("set-process-output-stream", Fset_process_output_stream, Sset_process_output_stream, (repv proc, repv stream), rep_Subr2) /*
::doc:rep.io.processes#set-process-output-stream::
set-process-output-stream PROCESS STREAM
Set the output-stream of PROCESS to STREAM. nil means discard all output.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
VPROC(proc)->pr_OutputStream = stream;
return(stream);
}
DEFUN("process-error-stream", Fprocess_error_stream, Sprocess_error_stream, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-error-stream::
process-error-stream PROCESS
Return the stream to which all standard-error output from PROCESS is sent.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_ErrorStream;
return(res);
}
DEFUN("set-process-error-stream", Fset_process_error_stream, Sset_process_error_stream, (repv proc, repv stream), rep_Subr2) /*
::doc:rep.io.processes#set-process-error-stream::
set-process-error-stream PROCESS STREAM
Set the error-stream of PROCESS to STREAM. nil means discard all output.
Note that this currently only works correctly with pipe connections.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
VPROC(proc)->pr_ErrorStream = stream;
return(stream);
}
DEFUN("process-function", Fprocess_function, Sprocess_function, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-function::
process-function PROCESS
Return the function which is called when PROCESS changes state (i.e. it
exits or is stopped).
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_NotifyFun;
return(res);
}
DEFUN("set-process-function", Fset_process_function, Sset_process_function, (repv proc, repv fn), rep_Subr2) /*
::doc:rep.io.processes#set-process-function::
set-process-function PROCESS FUNCTION
Set the function which is called when PROCESS changes state to FUNCTION.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
VPROC(proc)->pr_NotifyFun = fn;
return(fn);
}
DEFUN("process-dir", Fprocess_dir, Sprocess_dir, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-dir::
process-dir PROCESS
Return the name of the directory which becomes the working directory of
PROCESS when it is started.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_Dir;
return(res);
}
DEFUN("set-process-dir", Fset_process_dir, Sset_process_dir, (repv proc, repv dir), rep_Subr2) /*
::doc:rep.io.processes#set-process-dir::
set-process-dir PROCESS DIR
Set the directory of PROCESS to DIR.
::end:: */
{
rep_GC_root gc_proc;
rep_DECLARE1(proc, PROCESSP);
rep_DECLARE2(dir, rep_STRINGP);
/* Ensure that pr_Dir refers to an absolute local file */
rep_PUSHGC(gc_proc, proc);
dir = Flocal_file_name(rep_STRINGP(dir) ? dir : rep_VAL(&dot));
rep_POPGC;
if(dir && rep_STRINGP(dir))
VPROC(proc)->pr_Dir = dir;
else
VPROC(proc)->pr_Dir = Qnil;
return VPROC(proc)->pr_Dir;;
}
DEFUN("process-connection-type", Fprocess_connection_type, Sprocess_connection_type, (repv proc), rep_Subr1) /*
::doc:rep.io.processes#process-connection-type::
process-connection-type PROCESS
Returns a symbol defining the type of stream (i.e. pipe, pty, or
socketpair) used to connect PROCESS with its physical process.
::end:: */
{
repv res;
rep_DECLARE1(proc, PROCESSP);
res = VPROC(proc)->pr_ConnType;
return(res);
}
DEFUN("set-process-connection-type", Fset_process_connection_type, Sset_process_connection_type, (repv proc, repv type), rep_Subr2) /*
::doc:rep.io.processes#set-process-connection-type::
set-process-connection-type PROCESS TYPE
Define how PROCESS communicates with it's child process, TYPE may be
one of the following symbols:
pty Use a pty
pipe Three pipes are used
socketpair Use a socketpair
This function can only be used when PROCESS is not in use.
Note that only the `pipe' connection type allows process output and
process error output to be differentiated.
::end:: */
{
rep_DECLARE1(proc, PROCESSP);
if(PR_ACTIVE_P(VPROC(proc)))
type = Fsignal(Qprocess_error, rep_list_2(rep_VAL(&in_use), proc));
else
VPROC(proc)->pr_ConnType = type;
return(type);
}
DEFUN("active-processes", Factive_processes, Sactive_processes, (void),
rep_Subr0) /*
::doc:rep.io.processes#active-processes::
active-processes
Return a list containing all active process objects.
::end:: */
{
repv head = Qnil;
repv *ptr = &head;
struct Proc *p = process_chain;
while(p != 0)
{
if(PR_ACTIVE_P(p))
{
*ptr = Fcons(rep_VAL(p), Qnil);
ptr = &(rep_CDR(*ptr));
}
p = p->pr_Next;
}
return head;
}
#define MAX_HANDLERS 16
static void (*input_handlers[MAX_HANDLERS])(int);
static int n_input_handlers = 0;
void
rep_register_process_input_handler (void (*handler)(int))
{
assert (n_input_handlers < MAX_HANDLERS);
input_handlers[n_input_handlers++] = handler;
}
DEFUN("accept-process-output", Faccept_process_output,
Saccept_process_output, (repv secs, repv msecs), rep_Subr2) /*
::doc:rep.io.processes#accept-process-output::
accept-process-output [SECONDS] [MILLISECONDS]
Wait SECONDS plus MILLISECONDS for output from any asynchronous subprocesses.
If any arrives, process it, then return nil. Otherwise return t.
Note that output includes notification of process termination.
::end:: */
{
repv result = Qt;
rep_DECLARE2_OPT(secs, rep_NUMERICP);
rep_DECLARE3_OPT(msecs, rep_NUMERICP);
/* Only wait for output if nothing already waiting. */
if(!got_sigchld && !notify_chain)
{
result = (rep_accept_input_for_callbacks
((rep_get_long_int (secs) * 1000)
+ (rep_get_long_int (msecs)),
n_input_handlers, input_handlers));
}
if(got_sigchld || notify_chain)
{
result = Qnil;
rep_proc_periodically();
}
return result;
}
DEFUN("accept-process-output-1", Faccept_process_output_1,
Saccept_process_output_1,
(repv process, repv secs, repv msecs), rep_Subr3) /*
::doc:rep.io.processes#accept-process-output-1::
accept-process-output-1 PROCESS [SECONDS] [MILLISECONDS]
Wait SECONDS plus MILLISECONDS for output from the asynchronous
subprocess PROCESS. If any arrives, process it, then return nil.
Otherwise return t.
Note that output includes notification of process termination.
::end:: */
{
repv result = Qt;
rep_DECLARE1 (process, PROCESSP);
rep_DECLARE2_OPT(secs, rep_NUMERICP);
rep_DECLARE3_OPT(msecs, rep_NUMERICP);
/* Only wait for output if nothing already waiting. */
if (got_sigchld)
check_for_zombies ();
if (!notify_queued_p (VPROC (process)))
{
int fds[2];
fds[0] = VPROC (process)->pr_Stdout;
fds[1] = VPROC (process)->pr_Stderr;
result = (rep_accept_input_for_fds
((rep_get_long_int (secs) * 1000)
+ rep_get_long_int (msecs), 2, fds));
}
if (got_sigchld)
check_for_zombies ();
if (notify_queued_p (VPROC (process)))
{
notify_1 (VPROC (process));
result = Qt;
}
return result;
}
/* Don't use libc system (), since it blocks signals. */
repv
rep_system (char *command)
{
int pid, status;
int interrupt_count = 0;
pid = fork ();
switch (pid)
{
char *argv[4];
repv ret;
DEFSTRING (cant_fork, "can't fork ()");
case -1:
return Fsignal (Qerror, Fcons (rep_VAL (&cant_fork), Qnil));
case 0:
child_build_environ ();
argv[0] = "sh";
argv[1] = "-c";
argv[2] = command;
argv[3] = 0;
signal (SIGPIPE, SIG_DFL);
execve ("/bin/sh", argv, environ);
perror ("can't exec /bin/sh");
_exit (255);
default:
ret = Qnil;
rep_sig_restart (SIGCHLD, rep_FALSE);
while (1)
{
struct timeval timeout;
int x;
rep_TEST_INT_SLOW;
if (rep_INTERRUPTP)
{
static int signals[] = { SIGINT, SIGTERM, SIGQUIT };
if (interrupt_count < 3)
interrupt_count++;
kill (pid, signals[interrupt_count - 1]);
if (rep_throw_value == rep_int_cell)
rep_throw_value = rep_NULL;
}
x = waitpid (pid, &status, WNOHANG);
if (x == -1)
{
if (errno != EINTR && errno != EAGAIN)
{
DEFSTRING (cant_waitpid, "can't waitpid ()");
ret = Fsignal (Qerror,
Fcons (rep_VAL (&cant_waitpid), Qnil));
break;
}
}
else if (x == pid)
{
ret = rep_MAKE_INT (status);
break;
}
timeout.tv_sec = 1;
timeout.tv_usec = 0;
select (FD_SETSIZE, NULL, NULL, NULL, &timeout);
}
rep_sig_restart (SIGCHLD, rep_TRUE);
return ret;
}
}
void
rep_proc_init(void)
{
repv tem;
/* Setup SIGCHLD stuff. */
sigemptyset(&chld_sigset);
sigaddset(&chld_sigset, SIGCHLD);
chld_sigact.sa_handler = sigchld_handler;
chld_sigact.sa_mask = chld_sigset;
#ifdef SA_RESTART
chld_sigact.sa_flags = SA_RESTART;
#else
chld_sigact.sa_flags = 0;
#endif
sigaction(SIGCHLD, &chld_sigact, NULL);
/* Is this necessary?? Better safe than core-dumped ;-) */
signal(SIGPIPE, SIG_IGN);
rep_INTERN(pipe);
rep_INTERN(pty);
rep_INTERN(socketpair);
tem = rep_push_structure ("rep.io.processes");
rep_ADD_SUBR(Smake_process);
rep_ADD_SUBR(Sstart_process);
rep_ADD_SUBR(Scall_process);
rep_ADD_SUBR(Sinterrupt_process);
rep_ADD_SUBR(Skill_process);
rep_ADD_SUBR(Sstop_process);
rep_ADD_SUBR(Scontinue_process);
rep_ADD_SUBR(Ssignal_process);
rep_ADD_SUBR(Sprocess_exit_status);
rep_ADD_SUBR(Sprocess_exit_value);
rep_ADD_SUBR(Sprocess_id);
rep_ADD_SUBR(Sprocess_running_p);
rep_ADD_SUBR(Sprocess_stopped_p);
rep_ADD_SUBR(Sprocess_in_use_p);
rep_ADD_SUBR(Sprocessp);
rep_ADD_SUBR(Sprocess_prog);
rep_ADD_SUBR(Sset_process_prog);
rep_ADD_SUBR(Sprocess_args);
rep_ADD_SUBR(Sset_process_args);
rep_ADD_SUBR(Sprocess_output_stream);
rep_ADD_SUBR(Sset_process_output_stream);
rep_ADD_SUBR(Sprocess_error_stream);
rep_ADD_SUBR(Sset_process_error_stream);
rep_ADD_SUBR(Sprocess_function);
rep_ADD_SUBR(Sset_process_function);
rep_ADD_SUBR(Sprocess_dir);
rep_ADD_SUBR(Sset_process_dir);
rep_ADD_SUBR(Sprocess_connection_type);
rep_ADD_SUBR(Sset_process_connection_type);
rep_ADD_SUBR(Sactive_processes);
rep_ADD_SUBR(Saccept_process_output);
rep_ADD_SUBR(Saccept_process_output_1);
rep_pop_structure (tem);
process_type = rep_register_new_type ("subprocess", rep_ptr_cmp,
proc_prin, proc_prin,
proc_sweep, proc_mark,
mark_active_processes,
0, 0, proc_putc, proc_puts, 0, 0);
rep_register_process_input_handler (read_from_process);
rep_add_event_loop_callback (proc_periodically);
}
void
rep_proc_kill(void)
{
struct Proc *pr;
signal(SIGCHLD, SIG_DFL);
pr = process_chain;
while(pr)
{
struct Proc *nxt = pr->pr_Next;
kill_process(pr);
pr = nxt;
}
process_chain = NULL;
}
syntax highlighted by Code2HTML, v. 0.9.1