/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: jan@swi.psy.uva.nl WWW: http://www.swi-prolog.org Copyright (C): 1985-2002, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #ifdef HAVE_CONFIG_H #include #endif #include #include #include #include #include #include #include #include #include "clib.h" #include #include #include #ifdef HAVE_ALLOCA_H #include #endif /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Unix process management. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static IOSTREAM * name_to_stream(const char *name) { IOSTREAM *s; term_t t = PL_new_term_ref(); PL_put_atom_chars(t, name); if ( PL_get_stream_handle(t, &s) ) return s; return NULL; } static void flush_stream(const char *name) { IOSTREAM *s; if ( (s = name_to_stream(name)) ) Sflush(s); PL_release_stream(s); } static foreign_t pl_fork(term_t a0) { pid_t pid; flush_stream("user_output"); /* general call to flush all IO? */ if ( (pid = fork()) < 0 ) return PL_warning("fork/1: failed: %s", strerror(errno)); if ( pid > 0 ) return PL_unify_integer(a0, pid); else return PL_unify_atom_chars(a0, "child"); } #define free_argv(n) \ { int _k; \ for( _k=1; _k <= n; _k++) \ free(argv[_k]); \ free(argv); \ } static foreign_t pl_exec(term_t cmd) { int argc; atom_t name; if ( PL_get_name_arity(cmd, &name, &argc) ) { term_t a = PL_new_term_ref(); char **argv = malloc(sizeof(char*) * (argc + 2)); int i; argv[0] = (char *)PL_atom_chars(name); for(i=1; i<=argc; i++) { char *s; if ( PL_get_arg(i, cmd, a) && PL_get_chars(a, &s, CVT_ALL|REP_MB|BUF_MALLOC) ) argv[i] = s; else { free_argv(i-1); return pl_error("exec", 1, NULL, ERR_ARGTYPE, i, a, "atomic"); } } argv[argc+1] = NULL; execvp(argv[0], argv); free_argv(argc); return pl_error("exec", 1, NULL, ERR_ERRNO, errno, "execute", "command", cmd); } return pl_error("exec", 1, NULL, ERR_ARGTYPE, 1, cmd, "compound"); } static foreign_t pl_wait(term_t Pid, term_t Status) { int status; pid_t pid = wait(&status); if ( pid == -1 ) return pl_error("wait", 2, NULL, ERR_ERRNO, errno, "wait", "process", Pid); if ( PL_unify_integer(Pid, pid) ) { if ( WIFEXITED(status) ) return PL_unify_term(Status, CompoundArg("exited", 1), IntArg(WEXITSTATUS(status))); if ( WIFSIGNALED(status) ) return PL_unify_term(Status, CompoundArg("signaled", 1), IntArg(WTERMSIG(status))); if ( WIFSTOPPED(status) ) return PL_unify_term(Status, CompoundArg("stopped", 1), IntArg(WSTOPSIG(status))); assert(0); } return FALSE; } static foreign_t pl_kill(term_t Pid, term_t Sig) { int pid; int sig; if ( !PL_get_integer(Pid, &pid) ) return pl_error("kill", 2, NULL, ERR_ARGTYPE, 1, Pid, "pid"); if ( !PL_get_signum_ex(Sig, &sig) ) return FALSE; if ( kill(pid, sig) < 0 ) return pl_error("kill", 2, NULL, ERR_ERRNO, errno, "kill", "process", Pid); return TRUE; } /******************************* * STREAM STUFF * *******************************/ static foreign_t pl_pipe(term_t Read, term_t Write) { int fd[2]; IOSTREAM *in, *out; if ( pipe(fd) != 0 ) return pl_error("pipe", 2, NULL, ERR_ERRNO, errno, "create", "pipe", 0); in = Sfdopen(fd[0], "r"); out = Sfdopen(fd[1], "w"); if ( PL_open_stream(Read, in) && PL_open_stream(Write, out) ) return TRUE; return FALSE; } static int get_stream_no(term_t t, IOSTREAM **s, int *fn) { if ( PL_get_integer(t, fn) ) return TRUE; if ( PL_get_stream_handle(t, s) ) { *fn = Sfileno(*s); return TRUE; } return FALSE; } static foreign_t pl_dup(term_t from, term_t to) { IOSTREAM *f = NULL, *t = NULL; int rval = FALSE; int fn, tn; if ( !get_stream_no(from, &f, &fn) || !get_stream_no(to, &t, &tn) ) goto out; if ( dup2(fn, tn) < 0 ) { pl_error("dup", 2, NULL, ERR_ERRNO, errno, "dup", "stream", from); goto out; } else { rval = TRUE; } out: if ( f ) PL_release_stream(f); if ( t ) PL_release_stream(t); return rval; } static foreign_t pl_environ(term_t l) { extern char **environ; char **e; term_t t = PL_copy_term_ref(l); term_t t2 = PL_new_term_ref(); term_t nt = PL_new_term_ref(); term_t vt = PL_new_term_ref(); functor_t FUNCTOR_equal2 = PL_new_functor(PL_new_atom("="), 2); #if HAVE__NSGETENVIRON for(e = _NSGetEnviron(); *e; e++) #else for(e = environ; *e; e++) #endif { char *s = strchr(*e, '='); if ( !s ) s = *e + strlen(*e); { int len = s-*e; char *name = alloca(len+1); strncpy(name, *e, len); name[len] = '\0'; PL_put_atom_chars(nt, name); PL_put_atom_chars(vt, s+1); if ( !PL_cons_functor(nt, FUNCTOR_equal2, nt, vt) || !PL_unify_list(t, t2, t) || !PL_unify(t2, nt) ) return FALSE; } } return PL_unify_nil(t); } /******************************* * DEAMON IO * *******************************/ static atom_t error_file; /* file for output */ static int error_fd; /* and its fd */ static ssize_t read_eof(void *handle, char *buf, size_t count) { return 0; } static ssize_t write_null(void *handle, char *buf, size_t count) { if ( error_fd ) { if ( error_fd >= 0 ) return write(error_fd, buf, count); } else if ( error_file ) { error_fd = open(PL_atom_chars(error_file), O_WRONLY|O_CREAT|O_TRUNC, 0644); return write_null(handle, buf, count); } return count; } static long seek_error(void *handle, long pos, int whence) { return -1; } static int close_null(void *handle) { return 0; } static IOFUNCTIONS dummy = { read_eof, write_null, seek_error, close_null, NULL }; static void close_underlying_fd(IOSTREAM *s) { if ( s ) { int fd; if ( (fd = Sfileno(s)) >= 0 ) close(fd); s->functions = &dummy; s->flags &= ~SIO_FILE; /* no longer a file */ s->flags |= SIO_LBUF; /* do line-buffering */ } } static foreign_t pl_detach_IO() { char buf[100]; sprintf(buf, "/tmp/pl-out.%d", (int)getpid()); error_file = PL_new_atom(buf); close_underlying_fd(Serror); close_underlying_fd(Soutput); close_underlying_fd(Sinput); close_underlying_fd(name_to_stream("user_input")); close_underlying_fd(name_to_stream("user_output")); close_underlying_fd(name_to_stream("user_error")); #ifdef HAVE_SETSID setsid(); #else { int fd; if ( (fd = open("/dev/tty", 2)) ) { ioctl(fd, TIOCNOTTY, NULL); /* detach from controlling tty */ close(fd); } } #endif return TRUE; } install_t install_unix() { PL_register_foreign("fork", 1, pl_fork, 0); PL_register_foreign("exec", 1, pl_exec, 0); PL_register_foreign("wait", 2, pl_wait, 0); PL_register_foreign("kill", 2, pl_kill, 0); PL_register_foreign("pipe", 2, pl_pipe, 0); PL_register_foreign("dup", 2, pl_dup, 0); PL_register_foreign("detach_IO", 0, pl_detach_IO, 0); PL_register_foreign("environ", 1, pl_environ, 0); }