home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / callproc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-01-21  |  15.0 KB  |  591 lines
  1. /* Synchronous subprocess invocation for GNU Emacs.
  2.    Copyright (C) 1985-1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "config.h"
  21. #include "lisp.h"
  22.  
  23. #include <stdio.h>
  24. #include <signal.h>
  25. #include <sys/time.h>
  26. #include <sys/resource.h>
  27.  
  28. #include <sys/types.h>
  29. #define PRIO_PROCESS 0
  30. #include <sys/file.h>
  31. #ifdef USG5
  32. #include <fcntl.h>
  33. #endif
  34.  
  35. #ifndef O_RDONLY
  36. #define O_RDONLY 0
  37. #endif
  38.  
  39. #ifndef O_WRONLY
  40. #define O_WRONLY 1
  41. #endif
  42.  
  43. #if defined(sun) && !defined(USG)
  44. # include <vfork.h>
  45. #endif
  46.  
  47. #include "commands.h"
  48. #include "buffer.h"
  49. #include "paths.h"
  50. #include "process.h"
  51. #include "insdel.h"
  52.  
  53. #define max(a, b) ((a) > (b) ? (a) : (b))
  54.  
  55. Lisp_Object Vexec_path, Vexec_directory;
  56.  
  57. Lisp_Object Vshell_file_name;
  58.  
  59. #ifndef MAINTAIN_ENVIRONMENT
  60. /* List of strings to append to front of environment of
  61.    all subprocesses when they are started.  */
  62.  
  63. Lisp_Object Vprocess_environment;
  64. #endif
  65.  
  66. #ifdef BSD4_1
  67. /* Set nonzero when a synchronous subprocess is made,
  68.    and set to zero again when it is observed to die.
  69.    We wait for this to be zero in order to wait for termination.  */
  70. int synch_process_pid;
  71. #endif /* BSD4_1 */
  72.  
  73. /* True iff we are about to fork off a synchronous process or if we
  74.    are waiting for it.  */
  75. /* int synch_process_alive; */
  76.  
  77. /* Nonzero => this is a string explaining death of synchronous subprocess.  */
  78. char *synch_process_death;
  79.  
  80. /* Exit code of synchronous subprocess if positive,
  81.    minus the signal number if negative.  */
  82. int synch_process_retcode;
  83.  
  84. void child_setup ();
  85.  
  86.  
  87. static Lisp_Object
  88. call_process_cleanup (fdpid)
  89.      Lisp_Object fdpid;
  90. {
  91.   register Lisp_Object fd, pid;
  92.   fd = Fcar (fdpid);
  93.   pid = Fcdr (fdpid);
  94.   close (XFASTINT (fd));
  95.   kill (XFASTINT (pid), SIGKILL);
  96.   return Qnil;
  97. }
  98.  
  99. extern int errno;
  100. extern char *sys_errlist[];
  101. extern int sys_nerr;
  102.  
  103. static Lisp_Object fork_error;
  104.  
  105. static void
  106. report_fork_error (string, data)
  107.      char *string;
  108.      Lisp_Object data;
  109. {
  110.   Lisp_Object errstring;
  111.  
  112.   if (errno >= 0 && errno < sys_nerr)
  113.     errstring = build_string (sys_errlist[errno]);
  114.   else
  115.     errstring = build_string ("undocumented error code");
  116.  
  117.   /* System error messages are capitalized.  Downcase the initial. */
  118.   XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
  119.  
  120.   fork_error = Fcons (build_string (string), Fcons (errstring, data));
  121.  
  122.   /* terminate this branch of the fork, without closing stdin/out/etc. */
  123.   _exit (0);
  124. }
  125.  
  126. #ifdef VMS
  127. #ifdef __GNUC__
  128. #define    environ $$PsectAttributes_NOSHR$$environ
  129. extern char **environ;
  130. #else
  131. extern noshare char **environ;
  132. #endif
  133. #else
  134. extern char **environ;
  135. #endif
  136.  
  137. extern void wait_for_termination (int);
  138.  
  139. DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  140.   "Call PROGRAM synchronously in separate process.\n\
  141. The program's input comes from file INFILE (nil means `/dev/null').\n\
  142. Insert output in BUFFER before point; t means current buffer;\n\
  143.  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
  144. Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
  145. Remaining arguments are strings passed as command arguments to PROGRAM.\n\
  146. If BUFFER is nil or 0, returns immediately with value nil.\n\
  147. Otherwise waits for PROGRAM to terminate\n\
  148. and returns a numeric exit status or a signal name as a string.\n\
  149. If you quit, the process is killed with SIGKILL.")
  150.   (nargs, args)
  151.      int nargs;
  152.      register Lisp_Object *args;
  153. {
  154.   Lisp_Object display, buffer, path;
  155.   int fd[2];
  156.   int filefd;
  157.   register int pid;
  158.   char buf[1024];
  159.   int count = specpdl_depth;
  160.   register unsigned char **new_argv
  161.     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  162.   struct buffer *old = current_buffer;
  163.  
  164.   CHECK_STRING (args[0], 0);
  165.  
  166.   if (nargs <= 1 || NILP (args[1]))
  167. #ifdef VMS
  168.     args[1] = build_string ("NLA0:");
  169. #else
  170.     args[1] = build_string ("/dev/null");
  171. #endif /* not VMS */
  172.   else
  173.     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
  174.  
  175.   CHECK_STRING (args[1], 1);
  176.  
  177.   {
  178.     register Lisp_Object tem;
  179.     buffer = tem = args[2];
  180.     if (nargs <= 2)
  181.       buffer = Qnil;
  182.     else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
  183.            || XFASTINT (tem) == 0))
  184.       {
  185.     buffer = Fget_buffer (tem);
  186.     CHECK_BUFFER (buffer, 2);
  187.       }
  188.   }
  189.  
  190.   display = nargs > 3 ? args[3] : Qnil;
  191.  
  192.   {
  193.     register int i;
  194.     for (i = 4; i < nargs; i++)
  195.       {
  196.     CHECK_STRING (args[i], i);
  197.     new_argv[i - 3] = XSTRING (args[i])->data;
  198.       }
  199.     /* Program name is first command arg */
  200.     new_argv[0] = XSTRING (args[0])->data;
  201.     new_argv[i - 3] = 0;
  202.   }
  203.  
  204.   filefd = open ((char *)XSTRING (args[1])->data, O_RDONLY, 0);
  205.   if (filefd < 0)
  206.     {
  207.       report_file_error ("Opening process input file", Fcons (args[1], Qnil));
  208.     }
  209.   /* Search for program; barf if not found.  */
  210.   locate_file (Vexec_path, args[0], "", &path, X_OK);
  211.   if (NILP (path))
  212.     {
  213.       close (filefd);
  214.       report_file_error ("Searching for program", Fcons (args[0], Qnil));
  215.     }
  216.   new_argv[0] = XSTRING (path)->data;
  217.  
  218.   if (FIXNUMP (buffer))
  219. #ifdef VMS
  220.     fd[1] = open ("NLA0:", 0), fd[0] = -1;
  221. #else
  222.     fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
  223. #endif /* not VMS */
  224.   else
  225.     {
  226.       pipe (fd);
  227. #if 0
  228.       /* Replaced by close_process_descs */
  229.       set_exclusive_use (fd[0]);
  230. #endif
  231.     }
  232.  
  233.   synch_process_death = 0;
  234.   synch_process_retcode = 0;
  235.  
  236.   {
  237.     /* child_setup must clobber environ in systems with true vfork.
  238.        Protect it from permanent change.  */
  239.     register char **save_environ = environ;
  240.     register int fd1 = fd[1];
  241.     char **env;
  242. #ifdef EMACS_BTL
  243.     /* when performance monitoring is on, turn it off before the vfork(),
  244.        as the child has no handler for the signal -- when back in the
  245.        parent process, turn it back on if it was really on when you "turned
  246.        it off" */
  247.     extern int cadillac_stop_logging ();
  248.     extern int cadillac_start_logging ();
  249.     int logging_on = 0;
  250. #endif
  251.  
  252. #ifdef MAINTAIN_ENVIRONMENT
  253.     env = (char **) alloca (size_of_current_environ ());
  254.     get_current_environ (env);
  255. #else
  256.     env = environ;
  257. #endif /* MAINTAIN_ENVIRONMENT */
  258.  
  259. #ifdef EMACS_BTL
  260.     logging_on = cadillac_stop_logging ();
  261. #endif
  262.  
  263.     fork_error = Qnil;
  264.     pid = vfork ();
  265. #ifdef BSD4_1
  266.     /* cause SIGCHLD interrupts to look for this pid. */
  267.     synch_process_pid = pid;
  268. #endif /* BSD4_1 */
  269.  
  270.     if (pid == 0)
  271.       {
  272.     if (fd[0] >= 0)
  273.       close (fd[0]);
  274. #ifdef USG
  275. #ifdef HAVE_PTYS
  276.     setpgrp ();
  277. #endif
  278. #endif /* USG */
  279.     child_setup (filefd, fd1, fd1, new_argv, env);
  280.       }
  281. #ifdef EMACS_BTL
  282.     else if (logging_on)
  283.       cadillac_start_logging ();
  284. #endif
  285.  
  286.     environ = save_environ;
  287.  
  288.     close (filefd);
  289.     close (fd1);
  290.   }
  291.  
  292.   if (!NILP (fork_error))
  293.     while (1) Fsignal (Qfile_error, fork_error);
  294.  
  295.   if (pid < 0)
  296.     {
  297.       close (fd[0]);
  298.       report_file_error ("Doing vfork", Qnil);
  299.     }
  300.  
  301.   if (FIXNUMP (buffer))
  302.     {
  303. #ifndef subprocesses
  304.       wait_without_blocking ();
  305. #endif /* subprocesses */
  306.       return Qnil;
  307.     }
  308.  
  309.   record_unwind_protect (call_process_cleanup,
  310.              Fcons (make_number (fd[0]), make_number (pid)));
  311.  
  312.  
  313.   if (BUFFERP (buffer))
  314.     Fset_buffer (buffer);
  315.  
  316.   immediate_quit = 1;
  317.   QUIT;
  318.  
  319.   {
  320.     register int nread;
  321.  
  322.     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
  323.       {
  324.     immediate_quit = 0;
  325.     if (!NILP (buffer))
  326.       insert_raw_string (buf, nread);
  327.     if (!NILP (display) && INTERACTIVE)
  328.       redisplay_preserving_echo_area ();
  329.     immediate_quit = 1;
  330.     QUIT;
  331.       }
  332.   }
  333.  
  334.   /* Wait for it to terminate, unless it already has.  */
  335.   wait_for_termination (pid);
  336.  
  337.   immediate_quit = 0;
  338.  
  339.   internal_set_buffer (old);
  340.  
  341.   unbind_to (count, Qnil);
  342.  
  343.   if (synch_process_death)
  344.     return build_string (synch_process_death);
  345.   return make_number (synch_process_retcode);
  346. }
  347.  
  348. static Lisp_Object
  349. delete_temp_file (name)
  350.      Lisp_Object name;
  351. {
  352.   unlink ((char *) XSTRING (name)->data);
  353.   return (Qnil);
  354. }
  355.  
  356. DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  357.   3, MANY, 0,
  358.   "Send text from START to END to a synchronous process running PROGRAM.\n\
  359. Delete the text if fourth arg DELETE is non-nil.\n\
  360. Insert output in BUFFER before point; t means current buffer;\n\
  361.  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
  362. Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
  363. Remaining args are passed to PROGRAM at startup as command args.\n\
  364. If BUFFER is nil, returns immediately with value nil.\n\
  365. Otherwise waits for PROGRAM to terminate\n\
  366. and returns a numeric exit status or a signal name as a string.\n\
  367. If you quit, the process is killed with SIGKILL.")
  368.   (nargs, args)
  369.      int nargs;
  370.      register Lisp_Object *args;
  371. {
  372.   register Lisp_Object filename_string, start, end;
  373.   char tempfile[20];
  374.   int count = specpdl_depth;
  375.   Lisp_Object result;
  376.  
  377.   strcpy (tempfile, "/tmp/emacsXXXXXX");
  378.   mktemp (tempfile);
  379.  
  380.   filename_string = build_string (tempfile);
  381.   start = args[0];
  382.   end = args[1];
  383.   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
  384.   record_unwind_protect (delete_temp_file, filename_string);
  385.  
  386.   if (!NILP (args[3]))
  387.     Fdelete_region (start, end);
  388.  
  389.   args[3] = filename_string;
  390.   result = Fcall_process (nargs - 2, args + 2);
  391.   return unbind_to (count, result);
  392. }
  393.  
  394. /* This is the last thing run in a newly forked inferior
  395.    either synchronous or asynchronous.
  396.    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
  397.    Initialize inferior's priority, pgrp, connected dir and environment.
  398.    then exec another program based on new_argv.
  399.  
  400.    This function may change environ for the superior process.
  401.    Therefore, the superior process must save and restore the value
  402.    of environ around the vfork and the call to this function.
  403.  
  404.    ENV is the environment for the subprocess. */
  405.  
  406. extern void close_process_descs (void);
  407. extern void setpgrp_of_tty (int);
  408.  
  409. extern pid_t setpgrp ();
  410.  
  411. void
  412. child_setup (in, out, err, new_argv, env)
  413.      int in, out, err;
  414.      register char **new_argv;
  415.      char **env;
  416. {
  417.   register int pid = getpid();
  418.  
  419.   setpriority (PRIO_PROCESS, pid, 0);
  420.  
  421. #ifdef subprocesses
  422.   /* Close Emacs's descriptors that this process should not have.  */
  423.   close_process_descs ();
  424. #endif
  425.  
  426.   /* Note that use of alloca is always safe here.  It's obvious for systems
  427.      that do not have true vfork or that have true (stack) alloca.
  428.      If using vfork and C_ALLOCA it is safe because that changes
  429.      the superior's static variables as if the superior had done alloca
  430.      and will be cleaned up in the usual way.  */
  431.  
  432.   if (STRINGP (current_buffer->directory))
  433.     {
  434.       register unsigned char *temp;
  435.       register int i;
  436.  
  437.       i = XSTRING (current_buffer->directory)->size;
  438.       temp = (unsigned char *) alloca (i + 2);
  439.       memcpy (temp, XSTRING (current_buffer->directory)->data, i);
  440.       if (temp[i - 1] != '/') temp[i++] = '/';
  441.       temp[i] = 0;
  442.       /* Switch to that directory, and report any error.  */
  443.  
  444. #if 0
  445.  /* don't report the chdir error, or ange-ftp.el doesn't work. */
  446.       if (chdir (temp) < 0)
  447.     report_fork_error ("In chdir",
  448.                Fcons (current_buffer->directory, Qnil));
  449. #else
  450.       chdir ((char *) temp);
  451. #endif
  452.     }
  453.  
  454. #ifndef MAINTAIN_ENVIRONMENT
  455.   /* Set `env' to a vector of the strings in Vprocess_environment.  */
  456.   {
  457.     register Lisp_Object tem;
  458.     register char **new_env;
  459.     register int new_length;
  460.  
  461.     new_length = 0;
  462.     for (tem = Vprocess_environment;
  463.      (CONSP (tem)
  464.       && STRINGP (XCONS (tem)->car));
  465.      tem = XCONS (tem)->cdr)
  466.       new_length++;
  467.  
  468.     /* new_length + 1 to include terminating 0 */
  469.     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
  470.  
  471.     /* Copy the env strings into new_env.  */
  472.     for (tem = Vprocess_environment;
  473.      (CONSP (tem)
  474.       && STRINGP (XCONS (tem)->car));
  475.      tem = XCONS (tem)->cdr)
  476.       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
  477.     *new_env = 0;
  478.   }
  479. #endif /* Not MAINTAIN_ENVIRONMENT */
  480.  
  481.   close (0);
  482.   close (1);
  483.   close (2);
  484.  
  485.   dup2 (in, 0);
  486.   dup2 (out, 1);
  487.   dup2 (err, 2);
  488.   close (in);
  489.   close (out);
  490.   close (err);
  491.  
  492. #ifdef USG
  493. #ifndef HAVE_PTYS
  494.   setpgrp ();            /* No arguments but equivalent in this case */
  495. #endif
  496. #else
  497.   setpgrp (pid, pid);
  498. #endif /* USG */
  499.   setpgrp_of_tty (pid);
  500.  
  501. #ifdef vipc
  502.   something missing here;
  503. #endif /* vipc */
  504.  
  505.   /* execvp does not accept an environment arg so the only way
  506.      to pass this environment is to set environ.  Our caller
  507.      is responsible for restoring the ambient value of environ.  */
  508.   environ = env;
  509.   execvp (new_argv[0], new_argv);
  510.  
  511.   write (1, "Couldn't exec the program ", 26);
  512.   write (1, new_argv[0], strlen (new_argv[0]));
  513.   _exit (1);
  514. }
  515.  
  516. void
  517. init_callproc ()
  518. {
  519.   register char * sh;
  520.   Lisp_Object execdir;
  521.  
  522. #ifdef PATH_EXEC
  523.   /* Turn PATH_EXEC into a path.  `==' is just a string which we know
  524.      will not be the name of an environment variable.  */
  525.   Vexec_path = decode_env_path ("==", PATH_EXEC);
  526. #else
  527.   Vexec_path = Qnil;
  528. #endif
  529.   if (NILP (Vexec_path))
  530.     {
  531.       Vexec_directory = Qnil;
  532.       execdir = Qnil;
  533.     }
  534.   else
  535.     {
  536.       Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
  537.       execdir = Fdirectory_file_name (Vexec_directory);
  538.     }
  539.   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
  540.  
  541.   if (!NILP (execdir) && access ((char *)XSTRING (execdir)->data, 0) < 0)
  542.     {
  543.       printf ("Warning: executable/documentation dir (%s) does not exist.\n",
  544.           XSTRING (Vexec_directory)->data);
  545.       sleep (2);
  546.     }
  547.  
  548.   sh = (char *) egetenv ("SHELL");
  549.   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
  550.  
  551. #ifndef MAINTAIN_ENVIRONMENT
  552.   /* The equivalent of this operation was done
  553.      in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
  554.   Vprocess_environment = Qnil;
  555. #ifndef CANNOT_DUMP
  556.   if (initialized)
  557. #endif
  558.     {
  559.       char **envp;
  560.       for (envp = environ; *envp; envp++)
  561.     Vprocess_environment = Fcons (build_string (*envp),
  562.                       Vprocess_environment);
  563.     }
  564. #endif /* MAINTAIN_ENVIRONMENT */
  565. }
  566.  
  567. void
  568. syms_of_callproc ()
  569. {
  570.   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
  571.     "*File name to load inferior shells from.\n\
  572. Initialized from the SHELL environment variable.");
  573.  
  574.   DEFVAR_LISP ("exec-path", &Vexec_path,
  575.     "*List of directories to search programs to run in subprocesses.\n\
  576. Each element is a string (directory name) or nil (try default directory).");
  577.  
  578.   DEFVAR_LISP ("exec-directory", &Vexec_directory,
  579.     "Directory that holds programs that come with GNU Emacs,\n\
  580. intended for Emacs to invoke.");
  581.  
  582. #ifndef MAINTAIN_ENVIRONMENT
  583.   DEFVAR_LISP ("process-environment", &Vprocess_environment,
  584.     "List of strings to append to environment of subprocesses that are started.\n\
  585. Each string should have the format ENVVARNAME=VALUE.");
  586. #endif
  587.  
  588.   defsubr (&Scall_process);
  589.   defsubr (&Scall_process_region);
  590. }
  591.