1: /* Synchronous subprocess invocation for GNU Emacs.
    2:    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
    3:                  2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
    4: 
    5: This file is part of GNU Emacs.
    6: 
    7: GNU Emacs is free software; you can redistribute it and/or modify
    8: it 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: GNU Emacs is distributed in the hope that it will be useful,
   13: but 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 GNU Emacs; see the file COPYING.  If not, write to
   19: the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   20: Boston, MA 02110-1301, USA.  */
   21: 
   22: 
   23: #include <config.h>
   24: #include <signal.h>
   25: #include <errno.h>
   26: #include <stdio.h>
   27: 
   28: #ifndef USE_CRT_DLL
   29: extern int errno;
   30: #endif
   31: 
   32: /* Define SIGCHLD as an alias for SIGCLD.  */
   33: 
   34: #if !defined (SIGCHLD) && defined (SIGCLD)
   35: #define SIGCHLD SIGCLD
   36: #endif /* SIGCLD */
   37: 
   38: #include <sys/types.h>
   39: 
   40: #ifdef HAVE_UNISTD_H
   41: #include <unistd.h>
   42: #endif
   43: 
   44: #include <sys/file.h>
   45: #ifdef HAVE_FCNTL_H
   46: #define INCLUDED_FCNTL
   47: #include <fcntl.h>
   48: #endif
   49: 
   50: #ifdef WINDOWSNT
   51: #define NOMINMAX
   52: #include <windows.h>
   53: #include <stdlib.h>     /* for proper declaration of environ */
   54: #include <fcntl.h>
   55: #include "w32.h"
   56: #define _P_NOWAIT 1     /* from process.h */
   57: #endif
   58: 
   59: #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
   60: #define INCLUDED_FCNTL
   61: #include <fcntl.h>
   62: #include <sys/stat.h>
   63: #include <sys/param.h>
   64: #include <errno.h>
   65: #endif /* MSDOS */
   66: 
   67: #ifndef O_RDONLY
   68: #define O_RDONLY 0
   69: #endif
   70: 
   71: #ifndef O_WRONLY
   72: #define O_WRONLY 1
   73: #endif
   74: 
   75: #include "lisp.h"
   76: #include "commands.h"
   77: #include "buffer.h"
   78: #include "charset.h"
   79: #include "ccl.h"
   80: #include "coding.h"
   81: #include "composite.h"
   82: #include <epaths.h>
   83: #include "process.h"
   84: #include "syssignal.h"
   85: #include "systty.h"
   86: #include "blockinput.h"
   87: 
   88: #ifdef MSDOS
   89: #include "msdos.h"
   90: #endif
   91: 
   92: #ifdef VMS
   93: extern noshare char **environ;
   94: #else
   95: #ifndef USE_CRT_DLL
   96: extern char **environ;
   97: #endif
   98: #endif
   99: 
  100: #ifdef HAVE_SETPGID
  101: #if !defined (USG) || defined (BSD_PGRPS)
  102: #undef setpgrp
  103: #define setpgrp setpgid
  104: #endif
  105: #endif
  106: 
  107: Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
  108: Lisp_Object Vdata_directory, Vdoc_directory;
  109: Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
  110: Lisp_Object Vtemp_file_name_pattern;
  111: 
  112: Lisp_Object Vshell_file_name;
  113: 
  114: Lisp_Object Vprocess_environment;
  115: 
  116: #ifdef DOS_NT
  117: Lisp_Object Qbuffer_file_type;
  118: #endif /* DOS_NT */
  119: 
  120: /* True iff we are about to fork off a synchronous process or if we
  121:    are waiting for it.  */
  122: int synch_process_alive;
  123: 
  124: /* Nonzero => this is a string explaining death of synchronous subprocess.  */
  125: char *synch_process_death;
  126: 
  127: /* Nonzero => this is the signal number that terminated the subprocess.  */
  128: int synch_process_termsig;
  129: 
  130: /* If synch_process_death is zero,
  131:    this is exit code of synchronous subprocess.  */
  132: int synch_process_retcode;
  133: ^L
  134: /* Clean up when exiting Fcall_process.
  135:    On MSDOS, delete the temporary file on any kind of termination.
  136:    On Unix, kill the process and any children on termination by signal.  */
  137: 
  138: /* Nonzero if this is termination due to exit.  */
  139: static int call_process_exited;
  140: 
  141: #ifndef VMS  /* VMS version is in vmsproc.c.  */
  142: 
  143: static Lisp_Object
  144: call_process_kill (fdpid)
  145:      Lisp_Object fdpid;
  146: {
  147:   emacs_close (XFASTINT (Fcar (fdpid)));
  148:   EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
  149:   synch_process_alive = 0;
  150:   return Qnil;
  151: }
  152: 
  153: Lisp_Object
  154: call_process_cleanup (fdpid)
  155:      Lisp_Object fdpid;
  156: {
  157: #if defined (MSDOS) || defined (MAC_OS8)
  158:   /* for MSDOS fdpid is really (fd . tempfile)  */
  159:   register Lisp_Object file;
  160:   file = Fcdr (fdpid);
  161:   emacs_close (XFASTINT (Fcar (fdpid)));
  162:   if (strcmp (SDATA (file), NULL_DEVICE) != 0)
  163:     unlink (SDATA (file));
  164: #else /* not MSDOS and not MAC_OS8 */
  165:   register int pid = XFASTINT (Fcdr (fdpid));
  166: 
  167:   if (call_process_exited)
  168:     {
  169:       emacs_close (XFASTINT (Fcar (fdpid)));
  170:       return Qnil;
  171:     }
  172: 
  173:   if (EMACS_KILLPG (pid, SIGINT) == 0)
  174:     {
  175:       int count = SPECPDL_INDEX ();
  176:       record_unwind_protect (call_process_kill, fdpid);
  177:       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
  178:       immediate_quit = 1;
  179:       QUIT;
  180:       wait_for_termination (pid);
  181:       immediate_quit = 0;
  182:       specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
  183:       message1 ("Waiting for process to die...done");
  184:     }
  185:   synch_process_alive = 0;
  186:   emacs_close (XFASTINT (Fcar (fdpid)));
  187: #endif /* not MSDOS */
  188:   return Qnil;
  189: }
  190: 
  191: DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  192:        doc: /* Call PROGRAM synchronously in separate process.
  193: The remaining arguments are optional.
  194: The program's input comes from file INFILE (nil means `/dev/null').
  195: Insert output in BUFFER before point; t means current buffer;
  196:  nil for BUFFER means discard it; 0 means discard and don't wait.
  197: BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  198: REAL-BUFFER says what to do with standard output, as above,
  199: while STDERR-FILE says what to do with standard error in the child.
  200: STDERR-FILE may be nil (discard standard error output),
  201: t (mix it with ordinary output), or a file name string.
  202: 
  203: Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  204: Remaining arguments are strings passed as command arguments to PROGRAM.
  205: 
  206: If executable PROGRAM can't be found as an executable, `call-process'
  207: signals a Lisp error.  `call-process' reports errors in execution of
  208: the program only through its return and output.
  209: 
  210: If BUFFER is 0, `call-process' returns immediately with value nil.
  211: Otherwise it waits for PROGRAM to terminate
  212: and returns a numeric exit status or a signal description string.
  213: If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
  214: 
  215: usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
  216:      (nargs, args)
  217:      int nargs;
  218:      register Lisp_Object *args;
  219: {
  220:   Lisp_Object infile, buffer, current_dir, path;
  221:   int display_p;
  222:   int fd[2];
  223:   int filefd;
  224:   register int pid;
  225: #define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
  226: #define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
  227:   char buf[CALLPROC_BUFFER_SIZE_MAX];
  228:   int bufsize = CALLPROC_BUFFER_SIZE_MIN;
  229:   int count = SPECPDL_INDEX ();
  230: 
  231:   register const unsigned char **new_argv
  232:     = (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  233:   struct buffer *old = current_buffer;
  234:   /* File to use for stderr in the child.
  235:      t means use same as standard output.  */
  236:   Lisp_Object error_file;
  237: #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  238:   char *outf, *tempfile;
  239:   int outfilefd;
  240: #endif
  241: #ifdef MAC_OS8
  242:   char *tempfile;
  243:   int outfilefd;
  244: #endif
  245: #if 0
  246:   int mask;
  247: #endif
  248:   struct coding_system process_coding; /* coding-system of process output */
  249:   struct coding_system argument_coding; /* coding-system of arguments */
  250:   /* Set to the return value of Ffind_operation_coding_system.  */
  251:   Lisp_Object coding_systems;
  252: 
  253:   /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
  254:   coding_systems = Qt;
  255: 
  256:   CHECK_STRING (args[0]);
  257: 
  258:   error_file = Qt;
  259: 
  260: #ifndef subprocesses
  261:   /* Without asynchronous processes we cannot have BUFFER == 0.  */
  262:   if (nargs >= 3
  263:       && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
  264:     error ("Operating system cannot handle asynchronous subprocesses");
  265: #endif /* subprocesses */
  266: 
  267:   /* Decide the coding-system for giving arguments.  */
  268:   {
  269:     Lisp_Object val, *args2;
  270:     int i;
  271: 
  272:     /* If arguments are supplied, we may have to encode them.  */
  273:     if (nargs >= 5)
  274:       {
  275:         int must_encode = 0;
  276: 
  277:         for (i = 4; i < nargs; i++)
  278:           CHECK_STRING (args[i]);
  279: 
  280:         for (i = 4; i < nargs; i++)
  281:           if (STRING_MULTIBYTE (args[i]))
  282:             must_encode = 1;
  283: 
  284:         if (!NILP (Vcoding_system_for_write))
  285:           val = Vcoding_system_for_write;
  286:         else if (! must_encode)
  287:           val = Qnil;
  288:         else
  289:           {
  290:             args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
  291:             args2[0] = Qcall_process;
  292:             for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
  293:             coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
  294:             if (CONSP (coding_systems))
  295:               val = XCDR (coding_systems);
  296:             else if (CONSP (Vdefault_process_coding_system))
  297:               val = XCDR (Vdefault_process_coding_system);
  298:             else
  299:               val = Qnil;
  300:           }
  301:         setup_coding_system (Fcheck_coding_system (val), &argument_coding);
  302:         if (argument_coding.common_flags & CODING_ASCII_INCOMPATIBLE_MASK)
  303:           setup_coding_system (Qraw_text, &argument_coding);
  304:         if (argument_coding.eol_type == CODING_EOL_UNDECIDED)
  305:           argument_coding.eol_type = system_eol_type;
  306:       }
  307:   }
  308: 
  309:   if (nargs >= 2 && ! NILP (args[1]))
  310:     {
  311:       infile = Fexpand_file_name (args[1], current_buffer->directory);
  312:       CHECK_STRING (infile);
  313:     }
  314:   else
  315:     infile = build_string (NULL_DEVICE);
  316: 
  317:   if (nargs >= 3)
  318:     {
  319:       buffer = args[2];
  320: 
  321:       /* If BUFFER is a list, its meaning is
  322:          (BUFFER-FOR-STDOUT FILE-FOR-STDERR).  */
  323:       if (CONSP (buffer))
  324:         {
  325:           if (CONSP (XCDR (buffer)))
  326:             {
  327:               Lisp_Object stderr_file;
  328:               stderr_file = XCAR (XCDR (buffer));
  329: 
  330:               if (NILP (stderr_file) || EQ (Qt, stderr_file))
  331:                 error_file = stderr_file;
  332:               else
  333:                 error_file = Fexpand_file_name (stderr_file, Qnil);
  334:             }
  335: 
  336:           buffer = XCAR (buffer);
  337:         }
  338: 
  339:       if (!(EQ (buffer, Qnil)
  340:             || EQ (buffer, Qt)
  341:             || INTEGERP (buffer)))
  342:         {
  343:           Lisp_Object spec_buffer;
  344:           spec_buffer = buffer;
  345:           buffer = Fget_buffer_create (buffer);
  346:           /* Mention the buffer name for a better error message.  */
  347:           if (NILP (buffer))
  348:             CHECK_BUFFER (spec_buffer);
  349:           CHECK_BUFFER (buffer);
  350:         }
  351:     }
  352:   else
  353:     buffer = Qnil;
  354: 
  355:   /* Make sure that the child will be able to chdir to the current
  356:      buffer's current directory, or its unhandled equivalent.  We
  357:      can't just have the child check for an error when it does the
  358:      chdir, since it's in a vfork.
  359: 
  360:      We have to GCPRO around this because Fexpand_file_name,
  361:      Funhandled_file_name_directory, and Ffile_accessible_directory_p
  362:      might call a file name handling function.  The argument list is
  363:      protected by the caller, so all we really have to worry about is
  364:      buffer.  */
  365:   {
  366:     struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
  367: 
  368:     current_dir = current_buffer->directory;
  369: 
  370:     GCPRO4 (infile, buffer, current_dir, error_file);
  371: 
  372:     current_dir
  373:       = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
  374:                                 Qnil);
  375:     if (NILP (Ffile_accessible_directory_p (current_dir)))
  376:       report_file_error ("Setting current directory",
  377:                          Fcons (current_buffer->directory, Qnil));
  378: 
  379:     if (STRING_MULTIBYTE (infile))
  380:       infile = ENCODE_FILE (infile);
  381:     if (STRING_MULTIBYTE (current_dir))
  382:       current_dir = ENCODE_FILE (current_dir);
  383:     if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
  384:       error_file = ENCODE_FILE (error_file);
  385:     UNGCPRO;
  386:   }
  387: 
  388:   display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
  389: 
  390:   filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
  391:   if (filefd < 0)
  392:     {
  393:       infile = DECODE_FILE (infile);
  394:       report_file_error ("Opening process input file", Fcons (infile, Qnil));
  395:     }
  396:   /* Search for program; barf if not found.  */
  397:   {
  398:     struct gcpro gcpro1;
  399: 
  400:     GCPRO1 (current_dir);
  401:     openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
  402:     UNGCPRO;
  403:   }
  404:   if (NILP (path))
  405:     {
  406:       emacs_close (filefd);
  407:       report_file_error ("Searching for program", Fcons (args[0], Qnil));
  408:     }
  409: 
  410:   /* If program file name starts with /: for quoting a magic name,
  411:      discard that.  */
  412:   if (SBYTES (path) > 2 && SREF (path, 0) == '/'
  413:       && SREF (path, 1) == ':')
  414:     path = Fsubstring (path, make_number (2), Qnil);
  415: 
  416:   new_argv[0] = SDATA (path);
  417:   if (nargs > 4)
  418:     {
  419:       register int i;
  420:       struct gcpro gcpro1, gcpro2, gcpro3;
  421: 
  422:       GCPRO3 (infile, buffer, current_dir);
  423:       argument_coding.dst_multibyte = 0;
  424:       for (i = 4; i < nargs; i++)
  425:         {
  426:           argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
  427:           if (CODING_REQUIRE_ENCODING (&argument_coding))
  428:             {
  429:               /* We must encode this argument.  */
  430:               args[i] = encode_coding_string (args[i], &argument_coding, 1);
  431:               if (argument_coding.type == coding_type_ccl)
  432:                 setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
  433:             }
  434:           new_argv[i - 3] = SDATA (args[i]);
  435:         }
  436:       UNGCPRO;
  437:       new_argv[nargs - 3] = 0;
  438:     }
  439:   else
  440:     new_argv[1] = 0;
  441: 
  442: #ifdef MSDOS /* MW, July 1993 */
  443:   if ((outf = egetenv ("TMPDIR")))
  444:     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
  445:   else
  446:     {
  447:       tempfile = alloca (20);
  448:       *tempfile = '\0';
  449:     }
  450:   dostounix_filename (tempfile);
  451:   if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
  452:     strcat (tempfile, "/");
  453:   strcat (tempfile, "detmp.XXX");
  454:   mktemp (tempfile);
  455: 
  456:   outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  457:   if (outfilefd < 0)
  458:     {
  459:       emacs_close (filefd);
  460:       report_file_error ("Opening process output file",
  461:                          Fcons (build_string (tempfile), Qnil));
  462:     }
  463:   fd[0] = filefd;
  464:   fd[1] = outfilefd;
  465: #endif /* MSDOS */
  466: 
  467: #ifdef MAC_OS8
  468:   /* Since we don't have pipes on the Mac, create a temporary file to
  469:      hold the output of the subprocess.  */
  470:   tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
  471:   bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
  472:          SBYTES (Vtemp_file_name_pattern) + 1);
  473: 
  474:   mktemp (tempfile);
  475: 
  476:   outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
  477:   if (outfilefd < 0)
  478:     {
  479:       close (filefd);
  480:       report_file_error ("Opening process output file",
  481:                          Fcons (build_string (tempfile), Qnil));
  482:     }
  483:   fd[0] = filefd;
  484:   fd[1] = outfilefd;
  485: #endif /* MAC_OS8 */
  486: 
  487:   if (INTEGERP (buffer))
  488:     fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
  489:   else
  490:     {
  491: #ifndef MSDOS
  492: #ifndef MAC_OS8
  493:       errno = 0;
  494:       if (pipe (fd) == -1)
  495:         {
  496:           emacs_close (filefd);
  497:           report_file_error ("Creating process pipe", Qnil);
  498:         }
  499: #endif
  500: #endif
  501: #if 0
  502:       /* Replaced by close_process_descs */
  503:       set_exclusive_use (fd[0]);
  504: #endif
  505:     }
  506: 
  507:   {
  508:     /* child_setup must clobber environ in systems with true vfork.
  509:        Protect it from permanent change.  */
  510:     register char **save_environ = environ;
  511:     register int fd1 = fd[1];
  512:     int fd_error = fd1;
  513: 
  514: #if 0  /* Some systems don't have sigblock.  */
  515:     mask = sigblock (sigmask (SIGCHLD));
  516: #endif
  517: 
  518:     /* Record that we're about to create a synchronous process.  */
  519:     synch_process_alive = 1;
  520: 
  521:     /* These vars record information from process termination.
  522:        Clear them now before process can possibly terminate,
  523:        to avoid timing error if process terminates soon.  */
  524:     synch_process_death = 0;
  525:     synch_process_retcode = 0;
  526:     synch_process_termsig = 0;
  527: 
  528:     if (NILP (error_file))
  529:       fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
  530:     else if (STRINGP (error_file))
  531:       {
  532: #ifdef DOS_NT
  533:         fd_error = emacs_open (SDATA (error_file),
  534:                                O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
  535:                                S_IREAD | S_IWRITE);
  536: #else  /* not DOS_NT */
  537:         fd_error = creat (SDATA (error_file), 0666);
  538: #endif /* not DOS_NT */
  539:       }
  540: 
  541:     if (fd_error < 0)
  542:       {
  543:         emacs_close (filefd);
  544:         if (fd[0] != filefd)
  545:           emacs_close (fd[0]);
  546:         if (fd1 >= 0)
  547:           emacs_close (fd1);
  548: #ifdef MSDOS
  549:         unlink (tempfile);
  550: #endif
  551:         if (NILP (error_file))
  552:           error_file = build_string (NULL_DEVICE);
  553:         else if (STRINGP (error_file))
  554:           error_file = DECODE_FILE (error_file);
  555:         report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
  556:       }
  557: 
  558: #ifdef MAC_OS8
  559:     {
  560:       /* Call run_mac_command in sysdep.c here directly instead of doing
  561:          a child_setup as for MSDOS and other platforms.  Note that this
  562:          code does not handle passing the environment to the synchronous
  563:          Mac subprocess.  */
  564:       char *infn, *outfn, *errfn, *currdn;
  565: 
  566:       /* close these files so subprocess can write to them */
  567:       close (outfilefd);
  568:       if (fd_error != outfilefd)
  569:         close (