Commit 77d78be1 authored by Jim Blandy's avatar Jim Blandy
Browse files

*** empty log message ***

parent 6da58319
This diff is collapsed.
...@@ -19,6 +19,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ ...@@ -19,6 +19,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#include <signal.h> #include <signal.h>
#include <errno.h>
#include "config.h" #include "config.h"
...@@ -104,7 +105,7 @@ If you quit, the process is killed with SIGKILL.") ...@@ -104,7 +105,7 @@ If you quit, the process is killed with SIGKILL.")
int nargs; int nargs;
register Lisp_Object *args; register Lisp_Object *args;
{ {
Lisp_Object display, buffer, path; Lisp_Object display, infile, buffer, path, current_dir;
int fd[2]; int fd[2];
int filefd; int filefd;
register int pid; register int pid;
...@@ -118,23 +119,27 @@ If you quit, the process is killed with SIGKILL.") ...@@ -118,23 +119,27 @@ If you quit, the process is killed with SIGKILL.")
#endif #endif
CHECK_STRING (args[0], 0); CHECK_STRING (args[0], 0);
if (nargs <= 1 || NILP (args[1])) if (nargs >= 2 && ! NILP (args[1]))
args[1] = build_string ("/dev/null"); {
infile = Fexpand_file_name (args[1], current_buffer->directory);
CHECK_STRING (infile, 1);
}
else else
args[1] = Fexpand_file_name (args[1], current_buffer->directory); infile = build_string ("/dev/null");
CHECK_STRING (args[1], 1);
{ {
register Lisp_Object tem; register Lisp_Object tem;
buffer = tem = args[2]; if (nargs < 3)
if (nargs <= 2)
buffer = Qnil; buffer = Qnil;
else if (!(EQ (tem, Qnil) || EQ (tem, Qt) else
|| XFASTINT (tem) == 0))
{ {
buffer = Fget_buffer (tem); buffer = tem = args[2];
CHECK_BUFFER (buffer, 2); if (!(EQ (tem, Qnil) || EQ (tem, Qt)
|| XFASTINT (tem) == 0))
{
buffer = Fget_buffer (tem);
CHECK_BUFFER (buffer, 2);
}
} }
} }
...@@ -152,10 +157,10 @@ If you quit, the process is killed with SIGKILL.") ...@@ -152,10 +157,10 @@ If you quit, the process is killed with SIGKILL.")
new_argv[i - 3] = 0; new_argv[i - 3] = 0;
} }
filefd = open (XSTRING (args[1])->data, O_RDONLY, 0); filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
if (filefd < 0) if (filefd < 0)
{ {
report_file_error ("Opening process input file", Fcons (args[1], Qnil)); report_file_error ("Opening process input file", Fcons (infile, Qnil));
} }
/* Search for program; barf if not found. */ /* Search for program; barf if not found. */
openp (Vexec_path, args[0], "", &path, 1); openp (Vexec_path, args[0], "", &path, 1);
...@@ -177,6 +182,14 @@ If you quit, the process is killed with SIGKILL.") ...@@ -177,6 +182,14 @@ If you quit, the process is killed with SIGKILL.")
#endif #endif
} }
/* Make sure that the child will be able to chdir to the current
buffer's current directory. We can't just have the child check
for an error when it does the chdir, since it's in a vfork. */
current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (current_buffer->directory, Qnil));
{ {
/* child_setup must clobber environ in systems with true vfork. /* child_setup must clobber environ in systems with true vfork.
Protect it from permanent change. */ Protect it from permanent change. */
...@@ -204,7 +217,7 @@ If you quit, the process is killed with SIGKILL.") ...@@ -204,7 +217,7 @@ If you quit, the process is killed with SIGKILL.")
#else #else
setpgrp (pid, pid); setpgrp (pid, pid);
#endif /* USG */ #endif /* USG */
child_setup (filefd, fd1, fd1, new_argv, env, 0); child_setup (filefd, fd1, fd1, new_argv, env, 0, current_dir);
} }
#if 0 #if 0
...@@ -338,13 +351,19 @@ If you quit, the process is killed with SIGKILL.") ...@@ -338,13 +351,19 @@ If you quit, the process is killed with SIGKILL.")
ENV is the environment for the subprocess. ENV is the environment for the subprocess.
SET_PGRP is nonzero if we should put the subprocess into a separate SET_PGRP is nonzero if we should put the subprocess into a separate
process group. */ process group.
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
a decent error from within the child, this should be verified as an
executable directory by the parent. */
child_setup (in, out, err, new_argv, env, set_pgrp) child_setup (in, out, err, new_argv, env, set_pgrp, current_dir)
int in, out, err; int in, out, err;
register char **new_argv; register char **new_argv;
char **env; char **env;
int set_pgrp; int set_pgrp;
Lisp_Object current_dir;
{ {
register int pid = getpid(); register int pid = getpid();
...@@ -361,21 +380,24 @@ child_setup (in, out, err, new_argv, env, set_pgrp) ...@@ -361,21 +380,24 @@ child_setup (in, out, err, new_argv, env, set_pgrp)
the superior's static variables as if the superior had done alloca the superior's static variables as if the superior had done alloca
and will be cleaned up in the usual way. */ and will be cleaned up in the usual way. */
if (XTYPE (current_buffer->directory) == Lisp_String) {
{ register unsigned char *temp;
register unsigned char *temp; register int i;
register int i;
i = XSTRING (current_dir)->size;
i = XSTRING (current_buffer->directory)->size; temp = (unsigned char *) alloca (i + 2);
temp = (unsigned char *) alloca (i + 2); bcopy (XSTRING (current_dir)->data, temp, i);
bcopy (XSTRING (current_buffer->directory)->data, temp, i); if (temp[i - 1] != '/') temp[i++] = '/';
if (temp[i - 1] != '/') temp[i++] = '/'; temp[i] = 0;
temp[i] = 0;
/* Switch to that directory, and report any error. */ /* We can't signal an Elisp error here; we're in a vfork. Since
if (chdir (temp) < 0) the callers check the current directory before forking, this
report_file_error ("In chdir", should only return an error if the directory's permissions
Fcons (current_buffer->directory, Qnil)); are changed between the check and this chdir, but we should
} at least check. */
if (chdir (temp) < 0)
exit (errno);
}
/* Set `env' to a vector of the strings in Vprocess_environment. */ /* Set `env' to a vector of the strings in Vprocess_environment. */
{ {
...@@ -435,7 +457,7 @@ getenv_internal (var, varlen, value, valuelen) ...@@ -435,7 +457,7 @@ getenv_internal (var, varlen, value, valuelen)
char *var; char *var;
int varlen; int varlen;
char **value; char **value;
int **valuelen; int *valuelen;
{ {
Lisp_Object scan; Lisp_Object scan;
...@@ -448,7 +470,7 @@ getenv_internal (var, varlen, value, valuelen) ...@@ -448,7 +470,7 @@ getenv_internal (var, varlen, value, valuelen)
&& XSTRING (entry)->data[varlen] == '=' && XSTRING (entry)->data[varlen] == '='
&& ! bcmp (XSTRING (entry)->data, var, varlen)) && ! bcmp (XSTRING (entry)->data, var, varlen))
{ {
*value = XSTRING (entry)->data + (varlen + 1); *value = (char *) XSTRING (entry)->data + (varlen + 1);
*valuelen = XSTRING (entry)->size - (varlen + 1); *valuelen = XSTRING (entry)->size - (varlen + 1);
return 1; return 1;
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment