389 lines
		
	
	
		
			7.9 KiB
		
	
	
	
		
			C
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			389 lines
		
	
	
		
			7.9 KiB
		
	
	
	
		
			C
		
	
	
		
			Executable File
		
	
	
	
	
/*  $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 <config.h>
 | 
						|
#endif
 | 
						|
 | 
						|
#include <SWI-Stream.h>
 | 
						|
#include <stdio.h>
 | 
						|
#include <stdlib.h>
 | 
						|
#include <unistd.h>
 | 
						|
#include <sys/types.h>u
 | 
						|
#include <sys/wait.h>
 | 
						|
#include <fcntl.h>
 | 
						|
#include <assert.h>
 | 
						|
#include "clib.h"
 | 
						|
#include <signal.h>
 | 
						|
#include <string.h>
 | 
						|
#include <errno.h>
 | 
						|
#ifdef HAVE_ALLOCA_H
 | 
						|
#include <alloca.h>
 | 
						|
#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);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 |