root/trunk/src/callproc.c

/* Synchronous subprocess invocation for GNU Emacs.
   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
                 2002, 2003, 2004, 2005, 2006, 2007, 2008
                 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs 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 3, or (at your option)
any later version.

GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */


#include <config.h>
#include <signal.h>
#include <errno.h>
#include <stdio.h>

#ifndef USE_CRT_DLL
extern int errno;
#endif

/* Define SIGCHLD as an alias for SIGCLD.  */

#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif /* SIGCLD */

#include <sys/types.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#include <sys/file.h>
#ifdef HAVE_FCNTL_H
#define INCLUDED_FCNTL
#include <fcntl.h>
#endif

#ifdef WINDOWSNT
#define NOMINMAX
#include <windows.h>
#include <stdlib.h>     /* for proper declaration of environ */
#include <fcntl.h>
#include "w32.h"
#define _P_NOWAIT 1     /* from process.h */
#endif

#ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
#define INCLUDED_FCNTL
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/param.h>
#include <errno.h>
#endif /* MSDOS */

#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#ifndef O_WRONLY
#define O_WRONLY 1
#endif

#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
#include <epaths.h>
#include "process.h"
#include "syssignal.h"
#include "systty.h"
#include "blockinput.h"

#ifdef MSDOS
#include "msdos.h"
#endif

#ifdef VMS
extern noshare char **environ;
#else
#ifndef USE_CRT_DLL
extern char **environ;
#endif
#endif

#ifdef HAVE_SETPGID
#if !defined (USG) || defined (BSD_PGRPS)
#undef setpgrp
#define setpgrp setpgid
#endif
#endif

Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
Lisp_Object Vdata_directory, Vdoc_directory;
Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
Lisp_Object Vtemp_file_name_pattern;

Lisp_Object Vshell_file_name;

Lisp_Object Vprocess_environment;

#ifdef MEADOW
int mw32_process_expects_pty;
Lisp_Object Vmw32_process_under_setup;
#endif

#ifdef DOS_NT
Lisp_Object Qbuffer_file_type;
#endif /* DOS_NT */

/* True if we are about to fork off a synchronous process or if we
   are waiting for it.  */
int synch_process_alive;

/* Nonzero => this is a string explaining death of synchronous subprocess.  */
char *synch_process_death;

/* Nonzero => this is the signal number that terminated the subprocess.  */
int synch_process_termsig;

/* If synch_process_death is zero,
   this is exit code of synchronous subprocess.  */
int synch_process_retcode;

/* Clean up when exiting Fcall_process.
   On MSDOS, delete the temporary file on any kind of termination.
   On Unix, kill the process and any children on termination by signal.  */

/* Nonzero if this is termination due to exit.  */
static int call_process_exited;

#ifndef VMS  /* VMS version is in vmsproc.c.  */

static Lisp_Object
call_process_kill (fdpid)
     Lisp_Object fdpid;
{
  emacs_close (XFASTINT (Fcar (fdpid)));
  EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
  synch_process_alive = 0;
  return Qnil;
}

Lisp_Object
call_process_cleanup (fdpid)
     Lisp_Object fdpid;
{
#if defined (MSDOS) || defined (MAC_OS8)
  /* for MSDOS fdpid is really (fd . tempfile)  */
  register Lisp_Object file;
  file = Fcdr (fdpid);
  emacs_close (XFASTINT (Fcar (fdpid)));
  if (strcmp (SDATA (file), NULL_DEVICE) != 0)
    unlink (SDATA (file));
#else /* not MSDOS and not MAC_OS8 */
  register int pid = XFASTINT (Fcdr (fdpid));

  if (call_process_exited)
    {
      emacs_close (XFASTINT (Fcar (fdpid)));
      return Qnil;
    }

  if (EMACS_KILLPG (pid, SIGINT) == 0)
    {
      int count = SPECPDL_INDEX ();
      record_unwind_protect (call_process_kill, fdpid);
      message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
      immediate_quit = 1;
      QUIT;
      wait_for_termination (pid);
      immediate_quit = 0;
      specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
      message1 ("Waiting for process to die...done");
    }
  synch_process_alive = 0;
  emacs_close (XFASTINT (Fcar (fdpid)));
#endif /* not MSDOS */
  return Qnil;
}

DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
       doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
Insert output in BUFFER before point; t means current buffer;
 nil for BUFFER means discard it; 0 means discard and don't wait.
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
STDERR-FILE may be nil (discard standard error output),
t (mix it with ordinary output), or a file name string.

Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments are strings passed as command arguments to PROGRAM.

If executable PROGRAM can't be found as an executable, `call-process'
signals a Lisp error.  `call-process' reports errors in execution of
the program only through its return and output.

If BUFFER is 0, `call-process' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
     (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
  Lisp_Object infile, buffer, current_dir, path;
  int display_p;
  int fd[2];
  int filefd;
  register int pid;
#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
  char buf[CALLPROC_BUFFER_SIZE_MAX];
  int bufsize = CALLPROC_BUFFER_SIZE_MIN;
  int count = SPECPDL_INDEX ();

  register const unsigned char **new_argv
    = (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  struct buffer *old = current_buffer;
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
#ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  char *outf, *tempfile;
  int outfilefd;
#endif
#ifdef MAC_OS8
  char *tempfile;
  int outfilefd;
#endif
#if 0
  int mask;
#endif
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding; /* coding-system of arguments */
  /* Set to the return value of Ffind_operation_coding_system.  */
  Lisp_Object coding_systems;

  /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
  coding_systems = Qt;

  CHECK_STRING (args[0]);

  error_file = Qt;

#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
  if (nargs >= 3
      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

  /* Decide the coding-system for giving arguments.  */
  {
    Lisp_Object val, *args2;
    int i;

    /* If arguments are supplied, we may have to encode them.  */
    if (nargs >= 5)
      {
        int must_encode = 0;

        for (i = 4; i < nargs; i++)
          CHECK_STRING (args[i]);

        for (i = 4; i < nargs; i++)
          if (STRING_MULTIBYTE (args[i]))
            must_encode = 1;

        if (!NILP (Vcoding_system_for_write))
          val = Vcoding_system_for_write;
        else if (! must_encode)
          val = Qnil;
        else
          {
            args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
            args2[0] = Qcall_process;
            for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
            coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
            if (CONSP (coding_systems))
              val = XCDR (coding_systems);
            else if (CONSP (Vdefault_process_coding_system))
              val = XCDR (Vdefault_process_coding_system);
            else
              val = Qnil;
          }
        setup_coding_system (Fcheck_coding_system (val), &argument_coding);
        if (argument_coding.common_flags & CODING_ASCII_INCOMPATIBLE_MASK)
          setup_coding_system (Qraw_text, &argument_coding);
        if (argument_coding.eol_type == CODING_EOL_UNDECIDED)
          argument_coding.eol_type = system_eol_type;
      }
  }

  if (nargs >= 2 && ! NILP (args[1]))
    {
      infile = Fexpand_file_name (args[1], current_buffer->directory);
      CHECK_STRING (infile);
    }
  else
    infile = build_string (NULL_DEVICE);

  if (nargs >= 3)
    {
      buffer = args[2];

      /* If BUFFER is a list, its meaning is
         (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
      if (CONSP (buffer))
        {
          if (CONSP (XCDR (buffer)))
            {
              Lisp_Object stderr_file;
              stderr_file = XCAR (XCDR (buffer));

              if (NILP (stderr_file) || EQ (Qt, stderr_file))
                error_file = stderr_file;
              else
                error_file = Fexpand_file_name (stderr_file, Qnil);
            }

          buffer = XCAR (buffer);
        }

      if (!(EQ (buffer, Qnil)
            || EQ (buffer, Qt)
            || INTEGERP (buffer)))
        {
          Lisp_Object spec_buffer;
          spec_buffer = buffer;
          buffer = Fget_buffer_create (buffer);
          /* Mention the buffer name for a better error message.  */
          if (NILP (buffer))
            CHECK_BUFFER (spec_buffer);
          CHECK_BUFFER (buffer);
        }
    }
  else
    buffer = Qnil;

  /* Make sure that the child will be able to chdir to the current
     buffer's current directory, or its unhandled equivalent.  We
     can't just have the child check for an error when it does the
     chdir, since it's in a vfork.

     We have to GCPRO around this because Fexpand_file_name,
     Funhandled_file_name_directory, and Ffile_accessible_directory_p
     might call a file name handling function.  The argument list is
     protected by the caller, so all we really have to worry about is
     buffer.  */
  {
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;

    current_dir = current_buffer->directory;

    GCPRO4 (infile, buffer, current_dir, error_file);

    current_dir
      = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
                                Qnil);
    if (NILP (Ffile_accessible_directory_p (current_dir)))
      report_file_error ("Setting current directory",
                         Fcons (current_buffer->directory, Qnil));

    if (STRING_MULTIBYTE (infile))
      infile = ENCODE_FILE (infile);
    if (STRING_MULTIBYTE (current_dir))
      current_dir = ENCODE_FILE (current_dir);
    if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
      error_file = ENCODE_FILE (error_file);
    UNGCPRO;
  }

  display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);

#ifdef MEADOW
  infile = ENCODE_FILE (infile);
#endif
  filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
  if (filefd < 0)
    {
      infile = DECODE_FILE (infile);
      report_file_error ("Opening process input file", Fcons (infile, Qnil));
    }
  /* Search for program; barf if not found.  */
  {
    struct gcpro gcpro1;

    GCPRO1 (current_dir);
#ifndef MEADOW
    openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
#else
    /* for script execution on MSWindows, not apply exec_only for openp */
    /* openp without exec_only returns fd not used, free it immediately */
    {
      int fd = openp (Vexec_path, args[0], Vexec_suffixes, &path, Qnil);
      if (fd > 0) close(fd);
    }
#endif
    UNGCPRO;
  }
  if (NILP (path))
    {
      emacs_close (filefd);
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }

  /* If program file name starts with /: for quoting a magic name,
     discard that.  */
  if (SBYTES (path) > 2 && SREF (path, 0) == '/'
      && SREF (path, 1) == ':')
    path = Fsubstring (path, make_number (2), Qnil);

#ifdef MEADOW
  path = ENCODE_FILE (path);
#endif
  new_argv[0] = SDATA (path);
  if (nargs > 4)
    {
      register int i;
      struct gcpro gcpro1, gcpro2, gcpro3;

      GCPRO3 (infile, buffer, current_dir);
      argument_coding.dst_multibyte = 0;
      for (i = 4; i < nargs; i++)
        {
          argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
          if (CODING_REQUIRE_ENCODING (&argument_coding))
            {
              /* We must encode this argument.  */
              args[i] = encode_coding_string (args[i], &argument_coding, 1);
              if (argument_coding.type == coding_type_ccl)
                setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
            }
          new_argv[i - 3] = SDATA (args[i]);
        }
      UNGCPRO;
      new_argv[nargs - 3] = 0;
    }
  else
    new_argv[1] = 0;

#ifdef MSDOS /* MW, July 1993 */
  if ((outf = egetenv ("TMPDIR")))
    strcpy (tempfile = alloca (strlen (outf) + 20), outf);
  else
    {
      tempfile = alloca (20);
      *tempfile = '\0';
    }
  dostounix_filename (tempfile);
  if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
    strcat (tempfile, "/");
  strcat (tempfile, "detmp.XXX");
  mktemp (tempfile);

  outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  if (outfilefd < 0)
    {
      emacs_close (filefd);
      report_file_error ("Opening process output file",
                         Fcons (build_string (tempfile), Qnil));
    }
  fd[0] = filefd;
  fd[1] = outfilefd;
#endif /* MSDOS */

#ifdef MAC_OS8
  /* Since we don't have pipes on the Mac, create a temporary file to
     hold the output of the subprocess.  */
  tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
  bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
         SBYTES (Vtemp_file_name_pattern) + 1);

  mktemp (tempfile);

  outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  if (outfilefd < 0)
    {
      close (filefd);
      report_file_error ("Opening process output file",
                         Fcons (build_string (tempfile), Qnil));
    }
  fd[0] = filefd;
  fd[1] = outfilefd;
#endif /* MAC_OS8 */

  if (INTEGERP (buffer))
    fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
  else
    {
#ifndef MSDOS
#ifndef MAC_OS8
      errno = 0;
      if (pipe (fd) == -1)
        {
          emacs_close (filefd);
          report_file_error ("Creating process pipe", Qnil);
        }
#endif
#endif
#if 0
      /* Replaced by close_process_descs */
      set_exclusive_use (fd[0]);
#endif
    }

  {
    /* child_setup must clobber environ in systems with true vfork.
       Protect it from permanent change.  */
    register char **save_environ = environ;
    register int fd1 = fd[1];
    int fd_error = fd1;

#if 0  /* Some systems don't have sigblock.  */
    mask = sigblock (sigmask (SIGCHLD));
#endif

    /* Record that we're about to create a synchronous process.  */
    synch_process_alive = 1;

    /* These vars record information from process termination.
       Clear them now before process can possibly terminate,
       to avoid timing error if process terminates soon.  */
    synch_process_death = 0;
    synch_process_retcode = 0;
    synch_process_termsig = 0;

    if (NILP (error_file))
      fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
    else if (STRINGP (error_file))
      {
#ifdef DOS_NT
#ifdef MEADOW
        error_file = ENCODE_FILE (error_file);
#endif
        fd_error = emacs_open (SDATA (error_file),
                               O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
                               S_IREAD | S_IWRITE);
#else  /* not DOS_NT */
        fd_error = creat (SDATA (error_file), 0666);
#endif /* not DOS_NT */
      }

    if (fd_error < 0)
      {
        emacs_close (filefd);
        if (fd[0] != filefd)
          emacs_close (fd[0]);
        if (fd1 >= 0)
          emacs_close (fd1);
#ifdef MSDOS
        unlink (tempfile);
#endif
        if (NILP (error_file))
          error_file = build_string (NULL_DEVICE);
        else if (STRINGP (error_file))
          error_file = DECODE_FILE (error_file);
        report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
      }

#ifdef MAC_OS8
    {
      /* Call run_mac_command in sysdep.c here directly instead of doing
         a child_setup as for MSDOS and other platforms.  Note that this
         code does not handle passing the environment to the synchronous
         Mac subprocess.  */
      char *infn, *outfn, *errfn, *currdn;

      /* close these files so subprocess can write to them */
      close (outfilefd);
      if (fd_error != outfilefd)
        close (fd_error);
      fd1 = -1; /* No harm in closing that one! */

      infn = SDATA (infile);
      outfn = tempfile;
      if (NILP (error_file))
        errfn = NULL_DEVICE;
      else if (EQ (Qt, error_file))
        errfn = outfn;
      else
        errfn =