X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/afacaa1b181c04800688face1880fbfd410a9cee..9f62b5dd0e873f6048630e1e59a371112bdcf720:/src/callproc.c diff --git a/src/callproc.c b/src/callproc.c index 91f29bd589..2f6030f7e5 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1,6 +1,7 @@ /* Synchronous subprocess invocation for GNU Emacs. - Copyright (C) 1985-1988, 1993-1995, 1999-2013 - Free Software Foundation, Inc. + +Copyright (C) 1985-1988, 1993-1995, 1999-2014 Free Software Foundation, +Inc. This file is part of GNU Emacs. @@ -68,9 +69,10 @@ along with GNU Emacs. If not, see . */ /* Pattern used by call-process-region to make temp files. */ static Lisp_Object Vtemp_file_name_pattern; -/* The next two variables are valid only while record-unwind-protect - is in place during call-process for a synchronous subprocess. At - other times, their contents are irrelevant. Doing this via static +/* The next two variables are used while record-unwind-protect is in place + during call-process for a subprocess for which record_deleted_pid has + not yet been called. At other times, synch_process_pid is zero and + synch_process_tempfile's contents are irrelevant. Doing this via static C variables is more convenient than putting them into the arguments of record-unwind-protect, as they need to be updated at randomish times in the code, and Lisp cannot always store these values as @@ -80,26 +82,53 @@ static Lisp_Object Vtemp_file_name_pattern; /* If nonzero, a process-ID that has not been reaped. */ static pid_t synch_process_pid; -/* If nonnegative, a file descriptor that has not been closed. */ -static int synch_process_fd; +static Lisp_Object synch_process_tempfile; + +/* Indexes of file descriptors that need closing on call_process_kill. */ +enum + { + /* The subsidiary process's stdout and stderr. stdin is handled + separately, in either Fcall_process_region or create_temp_file. */ + CALLPROC_STDOUT, CALLPROC_STDERR, + + /* How to read from a pipe (or substitute) from the subsidiary process. */ + CALLPROC_PIPEREAD, + + /* A bound on the number of file descriptors. */ + CALLPROC_FDS + }; + +static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int *, Lisp_Object *); -/* Block SIGCHLD. */ +/* Return the current buffer's working directory, or the home + directory if it's unreachable, as a string suitable for a system call. + Signal an error if the result would not be an accessible directory. */ -void -block_child_signal (void) +Lisp_Object +encode_current_directory (void) { - sigset_t blocked; - sigemptyset (&blocked); - sigaddset (&blocked, SIGCHLD); - pthread_sigmask (SIG_BLOCK, &blocked, 0); -} + Lisp_Object dir; + struct gcpro gcpro1; -/* Unblock SIGCHLD. */ + dir = BVAR (current_buffer, directory); + GCPRO1 (dir); -void -unblock_child_signal (void) -{ - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); + dir = Funhandled_file_name_directory (dir); + + /* If the file name handler says that dir is unreachable, use + a sensible default. */ + if (NILP (dir)) + dir = build_string ("~"); + + dir = expand_and_dir_to_file (dir, Qnil); + + if (STRING_MULTIBYTE (dir)) + dir = ENCODE_FILE (dir); + if (! file_accessible_directory_p (SSDATA (dir))) + report_file_error ("Setting current directory", + BVAR (current_buffer, directory)); + + RETURN_UNGCPRO (dir); } /* If P is reapable, record it as a deleted process and kill it. @@ -107,80 +136,75 @@ unblock_child_signal (void) reaped on receipt of the first SIGCHLD after the critical section. */ void -record_kill_process (struct Lisp_Process *p) +record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile) { - block_child_signal (); +#ifndef MSDOS + sigset_t oldset; + block_child_signal (&oldset); if (p->alive) { + record_deleted_pid (p->pid, tempfile); p->alive = 0; - record_deleted_pid (p->pid); kill (- p->pid, SIGKILL); } - unblock_child_signal (); + unblock_child_signal (&oldset); +#endif /* !MSDOS */ } -/* Clean up when exiting call_process_cleanup. */ +/* Clean up files, file descriptors and processes created by Fcall_process. */ static void -call_process_kill (void) +delete_temp_file_ptr (Lisp_Object *name_ptr) { - if (synch_process_fd >= 0) - emacs_close (synch_process_fd); + Lisp_Object name = *name_ptr; + if (! NILP (name)) + unlink (SSDATA (name)); +} + +static void +call_process_kill (void *ptr) +{ + int *callproc_fd = ptr; + int i; + for (i = 0; i < CALLPROC_FDS; i++) + if (0 <= callproc_fd[i]) + emacs_close (callproc_fd[i]); if (synch_process_pid) { struct Lisp_Process proc; proc.alive = 1; proc.pid = synch_process_pid; - record_kill_process (&proc); + record_kill_process (&proc, synch_process_tempfile); + synch_process_pid = 0; } + else if (STRINGP (synch_process_tempfile)) + delete_temp_file_ptr (&synch_process_tempfile); } -/* 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. */ +/* Clean up when exiting Fcall_process: restore the buffer, and + kill the subsidiary process group if the process still exists. */ static void -call_process_cleanup (Lisp_Object arg) +call_process_cleanup (Lisp_Object buffer) { -#ifdef MSDOS - Lisp_Object buffer = Fcar (arg); - Lisp_Object file = Fcdr (arg); -#else - Lisp_Object buffer = arg; -#endif - Fset_buffer (buffer); #ifndef MSDOS - /* If the process still exists, kill its process group. */ if (synch_process_pid) { - ptrdiff_t count = SPECPDL_INDEX (); kill (-synch_process_pid, SIGINT); - record_unwind_protect_void (call_process_kill); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); immediate_quit = 1; QUIT; wait_for_termination (synch_process_pid, 0, 1); synch_process_pid = 0; immediate_quit = 0; - specpdl_ptr = specpdl + count; /* Discard the unwind protect. */ message1 ("Waiting for process to die...done"); } -#endif - - if (synch_process_fd >= 0) - emacs_close (synch_process_fd); - -#ifdef MSDOS - /* FILE is "" when we didn't actually create a temporary file in - call-process. */ - if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0')) - unlink (SDATA (file)); -#endif +#endif /* !MSDOS */ } #ifdef DOS_NT @@ -218,11 +242,47 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object infile, buffer, current_dir, path; + Lisp_Object infile, encoded_infile; + int filefd; + struct gcpro gcpro1; + ptrdiff_t count = SPECPDL_INDEX (); + + if (nargs >= 2 && ! NILP (args[1])) + { + infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); + CHECK_STRING (infile); + } + else + infile = build_string (NULL_DEVICE); + + GCPRO1 (infile); + encoded_infile = STRING_MULTIBYTE (infile) ? ENCODE_FILE (infile) : infile; + + filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0); + if (filefd < 0) + report_file_error ("Opening process input file", infile); + record_unwind_protect_ptr (close_file_ptr_unwind, &filefd); + UNGCPRO; + return unbind_to (count, call_process (nargs, args, &filefd, NULL)); +} + +/* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file. + + If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an + unwinder that is intended to remove the input temporary file; in + this case NARGS must be at least 2 and ARGS[1] is the file's name. + + At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */ + +static Lisp_Object +call_process (ptrdiff_t nargs, Lisp_Object *args, int *filefd, Lisp_Object *tempfile_ptr) +{ + Lisp_Object buffer, current_dir, path; bool display_p; - int fd0, fd1, filefd; + int fd0; + int callproc_fd[CALLPROC_FDS]; int status; - ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t i; USE_SAFE_ALLOCA; char **new_argv; @@ -231,19 +291,24 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * Lisp_Object error_file; Lisp_Object output_file = Qnil; #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ - char *outf, *tempfile = NULL; - int outfilefd; + char *tempfile = NULL; int pid; #else + sigset_t oldset; pid_t pid; #endif int child_errno; - int fd_output = -1; + int fd_output, fd_error; 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; - bool output_to_buffer = 1; + bool discard_output; + + dynwind_begin (); + + if (synch_process_pid) + error ("call-process invoked recursively"); /* Qt denotes that Ffind_operation_coding_system is not yet called. */ coding_systems = Qt; @@ -262,7 +327,6 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * /* Decide the coding-system for giving arguments. */ { Lisp_Object val, *args2; - ptrdiff_t i; /* If arguments are supplied, we may have to encode them. */ if (nargs >= 5) @@ -301,24 +365,16 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * } } - if (nargs >= 2 && ! NILP (args[1])) - { - infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); - CHECK_STRING (infile); - } + if (nargs < 3) + buffer = Qnil; 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), unless the first element is :file, in which case see the next paragraph. */ - if (CONSP (buffer) - && (! SYMBOLP (XCAR (buffer)) - || strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file"))) + if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile)) { if (CONSP (XCDR (buffer))) { @@ -335,9 +391,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * } /* If the buffer is (still) a list, it might be a (:file "file") spec. */ - if (CONSP (buffer) - && SYMBOLP (XCAR (buffer)) - && ! strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file")) + if (CONSP (buffer) && EQ (XCAR (buffer), QCfile)) { output_file = Fexpand_file_name (XCAR (XCDR (buffer)), BVAR (current_buffer, directory)); @@ -345,9 +399,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * buffer = Qnil; } - if (!(EQ (buffer, Qnil) - || EQ (buffer, Qt) - || INTEGERP (buffer))) + if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer))) { Lisp_Object spec_buffer; spec_buffer = buffer; @@ -358,8 +410,6 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * 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 @@ -372,28 +422,12 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * protected by the caller, so all we really have to worry about is buffer. */ { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - current_dir = BVAR (current_buffer, directory); - - GCPRO5 (infile, buffer, current_dir, error_file, output_file); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - current_dir = Funhandled_file_name_directory (current_dir); - if (NILP (current_dir)) - /* If the file name handler says that current_dir is unreachable, use - a sensible default. */ - current_dir = build_string ("~/"); - current_dir = expand_and_dir_to_file (current_dir, Qnil); - current_dir = Ffile_name_as_directory (current_dir); + current_dir = encode_current_directory (); - if (NILP (Ffile_accessible_directory_p (current_dir))) - report_file_error ("Setting current directory", - BVAR (current_buffer, directory)); + GCPRO4 (buffer, current_dir, error_file, output_file); - 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); if (STRINGP (output_file) && STRING_MULTIBYTE (output_file)) @@ -403,44 +437,24 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]); - filefd = emacs_open (SSDATA (infile), O_RDONLY, 0); - if (filefd < 0) - { - int open_errno = errno; - report_file_errno ("Opening process input file", DECODE_FILE (infile), - open_errno); - } - - if (STRINGP (output_file)) - { - fd_output = emacs_open (SSDATA (output_file), - O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, - default_output_mode); - if (fd_output < 0) - { - int open_errno = errno; - output_file = DECODE_FILE (output_file); - report_file_errno ("Opening process output file", - output_file, open_errno); - } - if (STRINGP (error_file) || NILP (error_file)) - output_to_buffer = 0; - } + for (i = 0; i < CALLPROC_FDS; i++) + callproc_fd[i] = -1; +#ifdef MSDOS + synch_process_tempfile = make_number (0); +#endif + record_unwind_protect_ptr (call_process_kill, callproc_fd); /* Search for program; barf if not found. */ { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + struct gcpro gcpro1, gcpro2, gcpro3; int ok; - GCPRO4 (infile, buffer, current_dir, error_file); - ok = openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK)); + GCPRO3 (buffer, current_dir, error_file); + ok = openp (Vexec_path, args[0], Vexec_suffixes, &path, + make_number (X_OK), false); UNGCPRO; if (ok < 0) - { - int openp_errno = errno; - emacs_close (filefd); - report_file_errno ("Searching for program", args[0], openp_errno); - } + report_file_error ("Searching for program", args[0]); } /* If program file name starts with /: for quoting a magic name, @@ -452,9 +466,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv); { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO5 (infile, buffer, current_dir, path, error_file); + GCPRO4 (buffer, current_dir, path, error_file); if (nargs > 4) { ptrdiff_t i; @@ -479,254 +493,230 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * UNGCPRO; } -#ifdef MSDOS /* MW, July 1993 */ + discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file)); - /* If we're redirecting STDOUT to a file, that file is already open - on fd_output. */ - if (fd_output < 0) +#ifdef MSDOS + if (! discard_output && ! STRINGP (output_file)) { - if ((outf = egetenv ("TMPDIR"))) - strcpy (tempfile = alloca (strlen (outf) + 20), outf); - else - { - tempfile = alloca (20); - *tempfile = '\0'; - } - dostounix_filename (tempfile, 0); + char const *tmpdir = egetenv ("TMPDIR"); + char const *outf = tmpdir ? tmpdir : ""; + tempfile = alloca (strlen (outf) + 20); + strcpy (tempfile, outf); + dostounix_filename (tempfile); if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') strcat (tempfile, "/"); - strcat (tempfile, "detmp.XXX"); + strcat (tempfile, "emXXXXXX"); mktemp (tempfile); - outfilefd = emacs_open (tempfile, O_WRONLY | O_CREAT | O_TRUNC, - S_IREAD | S_IWRITE); - if (outfilefd < 0) + if (!*tempfile) + report_file_error ("Opening process output file", Qnil); + output_file = build_string (tempfile); + synch_process_tempfile = output_file; + } +#endif + + if (discard_output) + { + fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0); + if (fd_output < 0) + report_file_error ("Opening null device", Qnil); + } + else if (STRINGP (output_file)) + { + fd_output = emacs_open (SSDATA (output_file), + O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, + default_output_mode); + if (fd_output < 0) { int open_errno = errno; - emacs_close (filefd); + output_file = DECODE_FILE (output_file); report_file_errno ("Opening process output file", - build_string (tempfile), open_errno); + output_file, open_errno); } } else - outfilefd = fd_output; - fd0 = filefd; - fd1 = outfilefd; -#endif /* MSDOS */ - - if (INTEGERP (buffer)) { - fd0 = -1; - fd1 = emacs_open (NULL_DEVICE, O_WRONLY, 0); - } - else - { -#ifndef MSDOS int fd[2]; if (emacs_pipe (fd) != 0) - { - int pipe_errno = errno; - emacs_close (filefd); - report_file_errno ("Creating process pipe", Qnil, pipe_errno); - } - fd0 = fd[0]; - fd1 = fd[1]; -#endif + report_file_error ("Creating process pipe", Qnil); + callproc_fd[CALLPROC_PIPEREAD] = fd[0]; + fd_output = fd[1]; } + callproc_fd[CALLPROC_STDOUT] = fd_output; - { - int fd_error = fd1; - - if (fd_output >= 0) - fd1 = fd_output; + fd_error = fd_output; - if (NILP (error_file)) - fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0); - else if (STRINGP (error_file)) - fd_error = emacs_open (SSDATA (error_file), + if (STRINGP (error_file) || (NILP (error_file) && !discard_output)) + { + fd_error = emacs_open ((STRINGP (error_file) + ? SSDATA (error_file) + : NULL_DEVICE), O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, default_output_mode); - - if (fd_error < 0) - { - int open_errno = errno; - emacs_close (filefd); - if (fd0 != filefd) - emacs_close (fd0); - 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_errno ("Cannot redirect stderr", error_file, open_errno); - } + if (fd_error < 0) + { + int open_errno = errno; + report_file_errno ("Cannot redirect stderr", + (STRINGP (error_file) + ? DECODE_FILE (error_file) + : build_string (NULL_DEVICE)), + open_errno); + } + callproc_fd[CALLPROC_STDERR] = fd_error; + } #ifdef MSDOS /* MW, July 1993 */ - /* Note that on MSDOS `child_setup' actually returns the child process - exit status, not its PID, so assign it to status below. */ - pid = child_setup (filefd, outfilefd, fd_error, new_argv, 0, current_dir); - child_errno = errno; - - emacs_close (outfilefd); - if (fd_error != outfilefd) - emacs_close (fd_error); - if (pid < 0) - { - synchronize_system_messages_locale (); - return - code_convert_string_norecord (build_string (strerror (child_errno)), - Vlocale_coding_system, 0); - } - status = pid; - fd1 = -1; /* No harm in closing that one! */ - if (tempfile) + /* Note that on MSDOS `child_setup' actually returns the child process + exit status, not its PID, so assign it to status below. */ + pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); + + if (pid < 0) + { + child_errno = errno; + dynwind_end (); + synchronize_system_messages_locale (); + return + code_convert_string_norecord (build_string (strerror (child_errno)), + Vlocale_coding_system, 0); + } + status = pid; + + for (i = 0; i < CALLPROC_FDS; i++) + if (0 <= callproc_fd[i]) { - /* Since CRLF is converted to LF within `decode_coding', we - can always open a file with binary mode. */ - fd0 = emacs_open (tempfile, O_RDONLY | O_BINARY, 0); - if (fd0 < 0) - { - int open_errno = errno; - unlink (tempfile); - emacs_close (filefd); - report_file_errno ("Cannot re-open temporary file", - build_string (tempfile), open_errno); - } + emacs_close (callproc_fd[i]); + callproc_fd[i] = -1; } - else - fd0 = -1; /* We are not going to read from tempfile. */ + emacs_close (*filefd); + *filefd = -1; + + if (tempfile) + { + /* Since CRLF is converted to LF within `decode_coding', we + can always open a file with binary mode. */ + callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, + O_RDONLY | O_BINARY, 0); + if (callproc_fd[CALLPROC_PIPEREAD] < 0) + { + int open_errno = errno; + report_file_errno ("Cannot re-open temporary file", + build_string (tempfile), open_errno); + } + } + #endif /* MSDOS */ - /* Do the unwind-protect now, even though the pid is not known, so - that no storage allocation is done in the critical section. - The actual PID will be filled in during the critical section. */ - synch_process_pid = 0; - synch_process_fd = fd0; + /* Do the unwind-protect now, even though the pid is not known, so + that no storage allocation is done in the critical section. + The actual PID will be filled in during the critical section. */ + record_unwind_protect (call_process_cleanup, Fcurrent_buffer ()); -#ifdef MSDOS - /* MSDOS needs different cleanup information. */ - record_unwind_protect (call_process_cleanup, - Fcons (Fcurrent_buffer (), - build_string (tempfile ? tempfile : ""))); -#else - record_unwind_protect (call_process_cleanup, Fcurrent_buffer ()); +#ifndef MSDOS - block_input (); - block_child_signal (); + block_input (); + block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir); - /* We need to record the input file of this child, for when we are - called from call-process-region to create an async subprocess. - That's because call-process-region's unwind procedure will - attempt to delete the temporary input file, which will fail - because that file is still in use. Recording it with the child - will allow us to delete the file when the subprocess exits. - The second part of this is in delete_temp_file, q.v. */ - if (pid > 0 && INTEGERP (buffer) && nargs >= 2 && !NILP (args[1])) - record_infile (pid, xstrdup (SSDATA (infile))); + pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); #else /* not WINDOWSNT */ - /* vfork, and prevent local vars from being clobbered by the vfork. */ + /* vfork, and prevent local vars from being clobbered by the vfork. */ + { + Lisp_Object volatile buffer_volatile = buffer; + Lisp_Object volatile coding_systems_volatile = coding_systems; + Lisp_Object volatile current_dir_volatile = current_dir; + bool volatile display_p_volatile = display_p; + int volatile fd_error_volatile = fd_error; + int *volatile filefd_volatile = filefd; + char **volatile new_argv_volatile = new_argv; + int volatile callproc_fd_volatile[CALLPROC_FDS]; + for (i = 0; i < CALLPROC_FDS; i++) + callproc_fd_volatile[i] = callproc_fd[i]; + + pid = vfork (); + + buffer = buffer_volatile; + coding_systems = coding_systems_volatile; + current_dir = current_dir_volatile; + display_p = display_p_volatile; + fd_error = fd_error_volatile; + filefd = filefd_volatile; + new_argv = new_argv_volatile; + + for (i = 0; i < CALLPROC_FDS; i++) + callproc_fd[i] = callproc_fd_volatile[i]; + fd_output = callproc_fd[CALLPROC_STDOUT]; + } + + if (pid == 0) { - Lisp_Object volatile buffer_volatile = buffer; - Lisp_Object volatile coding_systems_volatile = coding_systems; - Lisp_Object volatile current_dir_volatile = current_dir; - bool volatile display_p_volatile = display_p; - bool volatile output_to_buffer_volatile = output_to_buffer; - bool volatile sa_must_free_volatile = sa_must_free; - int volatile fd1_volatile = fd1; - int volatile fd_error_volatile = fd_error; - int volatile fd_output_volatile = fd_output; - int volatile filefd_volatile = filefd; - ptrdiff_t volatile count_volatile = count; - ptrdiff_t volatile sa_count_volatile = sa_count; - char **volatile new_argv_volatile = new_argv; - - pid = vfork (); - child_errno = errno; + unblock_child_signal (&oldset); - buffer = buffer_volatile; - coding_systems = coding_systems_volatile; - current_dir = current_dir_volatile; - display_p = display_p_volatile; - output_to_buffer = output_to_buffer_volatile; - sa_must_free = sa_must_free_volatile; - fd1 = fd1_volatile; - fd_error = fd_error_volatile; - fd_output = fd_output_volatile; - filefd = filefd_volatile; - count = count_volatile; - sa_count = sa_count_volatile; - new_argv = new_argv_volatile; - - fd0 = synch_process_fd; - } + setsid (); - if (pid == 0) - { - unblock_child_signal (); + /* Emacs ignores SIGPIPE, but the child should not. */ + signal (SIGPIPE, SIG_DFL); + /* Likewise for SIGPROF. */ +#ifdef SIGPROF + signal (SIGPROF, SIG_DFL); +#endif - if (fd0 >= 0) - emacs_close (fd0); + child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir); + } - setsid (); +#endif /* not WINDOWSNT */ - /* Emacs ignores SIGPIPE, but the child should not. */ - signal (SIGPIPE, SIG_DFL); + child_errno = errno; - child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir); - } + if (pid > 0) + { + synch_process_pid = pid; -#endif /* not WINDOWSNT */ + if (INTEGERP (buffer)) + { + if (tempfile_ptr) + { + record_deleted_pid (pid, *tempfile_ptr); + *tempfile_ptr = Qnil; + } + else + { + record_deleted_pid (pid, Qnil); + } + synch_process_pid = 0; + } + } - child_errno = errno; + unblock_child_signal (&oldset); + unblock_input (); - if (pid > 0) + if (pid < 0) + report_file_errno ("Doing vfork", Qnil, child_errno); + + /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD] + since we will use that to read input from. */ + for (i = 0; i < CALLPROC_FDS; i++) + if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i]) { - if (INTEGERP (buffer)) - record_deleted_pid (pid); - else - synch_process_pid = pid; + emacs_close (callproc_fd[i]); + callproc_fd[i] = -1; } + emacs_close (*filefd); + *filefd = -1; - unblock_child_signal (); - unblock_input (); - - /* The MSDOS case did this already. */ - if (fd_error >= 0) - emacs_close (fd_error); #endif /* not MSDOS */ - /* Close most of our file descriptors, but not fd0 - since we will use that to read input from. */ - emacs_close (filefd); - if (fd_output >= 0) - emacs_close (fd_output); - if (fd1 >= 0 && fd1 != fd_error) - emacs_close (fd1); - } - - if (pid < 0) - report_file_errno ("Doing vfork", Qnil, child_errno); - if (INTEGERP (buffer)) - return unbind_to (count, Qnil); + { + dynwind_end (); + return Qnil; + } if (BUFFERP (buffer)) Fset_buffer (buffer); - if (NILP (buffer)) - { - /* If BUFFER is nil, we must read process output once and then - discard it, so setup coding system but with nil. */ - setup_coding_system (Qnil, &process_coding); - process_coding.dst_multibyte = 0; - } - else + fd0 = callproc_fd[CALLPROC_PIPEREAD]; + + if (0 <= fd0) { Lisp_Object val, *args2; @@ -762,26 +752,24 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * setup_coding_system (val, &process_coding); process_coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); + process_coding.src_multibyte = 0; } - process_coding.src_multibyte = 0; immediate_quit = 1; QUIT; - if (output_to_buffer) + if (0 <= fd0) { enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN }; char buf[CALLPROC_BUFFER_SIZE_MAX]; int bufsize = CALLPROC_BUFFER_SIZE_MIN; int nread; - bool first = 1; EMACS_INT total_read = 0; int carryover = 0; bool display_on_the_fly = display_p; - struct coding_system saved_coding; + struct coding_system saved_coding = process_coding; - saved_coding = process_coding; while (1) { /* Repeatedly read until we've filled as much as possible @@ -812,58 +800,58 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * /* Now NREAD is the total amount of data in the buffer. */ immediate_quit = 0; - if (!NILP (buffer)) - { - if (NILP (BVAR (current_buffer, enable_multibyte_characters)) - && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) - insert_1_both (buf, nread, nread, 0, 1, 0); - else - { /* We have to decode the input. */ - Lisp_Object curbuf; - ptrdiff_t count1 = SPECPDL_INDEX (); - - XSETBUFFER (curbuf, current_buffer); - /* We cannot allow after-change-functions be run - during decoding, because that might modify the - buffer, while we rely on process_coding.produced to - faithfully reflect inserted text until we - TEMP_SET_PT_BOTH below. */ - specbind (Qinhibit_modification_hooks, Qt); - decode_coding_c_string (&process_coding, - (unsigned char *) buf, nread, curbuf); - unbind_to (count1, Qnil); - if (display_on_the_fly - && CODING_REQUIRE_DETECTION (&saved_coding) - && ! CODING_REQUIRE_DETECTION (&process_coding)) - { - /* We have detected some coding system. But, - there's a possibility that the detection was - done by insufficient data. So, we give up - displaying on the fly. */ - if (process_coding.produced > 0) - del_range_2 (process_coding.dst_pos, - process_coding.dst_pos_byte, - process_coding.dst_pos - + process_coding.produced_char, - process_coding.dst_pos_byte - + process_coding.produced, 0); - display_on_the_fly = 0; - process_coding = saved_coding; - carryover = nread; - /* This is to make the above condition always - fails in the future. */ - saved_coding.common_flags - &= ~CODING_REQUIRE_DETECTION_MASK; - continue; - } - - TEMP_SET_PT_BOTH (PT + process_coding.produced_char, - PT_BYTE + process_coding.produced); - carryover = process_coding.carryover_bytes; - if (carryover > 0) - memcpy (buf, process_coding.carryover, - process_coding.carryover_bytes); + if (!nread) + ; + else if (NILP (BVAR (current_buffer, enable_multibyte_characters)) + && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) + insert_1_both (buf, nread, nread, 0, 1, 0); + else + { /* We have to decode the input. */ + Lisp_Object curbuf; + + dynwind_begin (); + XSETBUFFER (curbuf, current_buffer); + /* FIXME: Call signal_after_change! */ + prepare_to_modify_buffer (PT, PT, NULL); + /* We cannot allow after-change-functions be run + during decoding, because that might modify the + buffer, while we rely on process_coding.produced to + faithfully reflect inserted text until we + TEMP_SET_PT_BOTH below. */ + specbind (Qinhibit_modification_hooks, Qt); + decode_coding_c_string (&process_coding, + (unsigned char *) buf, nread, curbuf); + dynwind_end (); + if (display_on_the_fly + && CODING_REQUIRE_DETECTION (&saved_coding) + && ! CODING_REQUIRE_DETECTION (&process_coding)) + { + /* We have detected some coding system, but the + detection may have been via insufficient data. + So give up displaying on the fly. */ + if (process_coding.produced > 0) + del_range_2 (process_coding.dst_pos, + process_coding.dst_pos_byte, + (process_coding.dst_pos + + process_coding.produced_char), + (process_coding.dst_pos_byte + + process_coding.produced), + 0); + display_on_the_fly = 0; + process_coding = saved_coding; + carryover = nread; + /* Make the above condition always fail in the future. */ + saved_coding.common_flags + &= ~CODING_REQUIRE_DETECTION_MASK; + continue; } + + TEMP_SET_PT_BOTH (PT + process_coding.produced_char, + PT_BYTE + process_coding.produced); + carryover = process_coding.carryover_bytes; + if (carryover > 0) + memcpy (buf, process_coding.carryover, + process_coding.carryover_bytes); } if (process_coding.mode & CODING_MODE_LAST_BLOCK) @@ -877,12 +865,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (display_p) { - if (first) - prepare_menu_bars (); - first = 0; redisplay_preserve_echo_area (1); /* This variable might have been set to 0 for code - detection. In that case, we set it back to 1 because + detection. In that case, set it back to 1 because we should have already detected a coding system. */ display_on_the_fly = 1; } @@ -901,7 +886,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * #ifndef MSDOS /* Wait for it to terminate, unless it already has. */ - wait_for_termination (pid, &status, !output_to_buffer); + wait_for_termination (pid, &status, fd0 < 0); #endif immediate_quit = 0; @@ -911,7 +896,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * synch_process_pid = 0; SAFE_FREE (); - unbind_to (count, Qnil); + dynwind_end (); if (WIFSIGNALED (status)) { @@ -931,37 +916,18 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * return make_number (WEXITSTATUS (status)); } -static void -delete_temp_file (Lisp_Object name) -{ - /* Suppress jka-compr handling, etc. */ - ptrdiff_t count = SPECPDL_INDEX (); - specbind (intern ("file-name-handler-alist"), Qnil); -#ifdef WINDOWSNT - /* If this is called when the subprocess didn't exit yet, the - attempt to delete its input file will fail. In that case, we - schedule the file for deletion when the subprocess exits. This - is the 2nd part of handling this situation; see the call to - record_infile in call-process above, for the first part. */ - if (!internal_delete_file (name)) - { - Lisp_Object encoded_file = ENCODE_FILE (name); - - record_pending_deletion (SSDATA (encoded_file)); - } -#else - internal_delete_file (name); -#endif - unbind_to (count, Qnil); -} - /* Create a temporary file suitable for storing the input data of call-process-region. NARGS and ARGS are the same as for - call-process-region. */ + call-process-region. Store into *FILENAME_STRING_PTR a Lisp string + naming the file, and return a file descriptor for reading. + Unwind-protect the file, so that the file descriptor will be closed + and the file removed when the caller unwinds the specpdl stack. */ -static Lisp_Object -create_temp_file (ptrdiff_t nargs, Lisp_Object *args) +static void +create_temp_file (ptrdiff_t nargs, Lisp_Object *args, + Lisp_Object *filename_string_ptr, int *fdp) { + int fd; struct gcpro gcpro1; Lisp_Object filename_string; Lisp_Object val, start, end; @@ -988,6 +954,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); char *tempfile; + ptrdiff_t count; #ifdef WINDOWSNT /* Cannot use the result of Fexpand_file_name, because it @@ -1008,26 +975,14 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args) GCPRO1 (filename_string); tempfile = SSDATA (filename_string); - { - int fd; - -#ifdef HAVE_MKOSTEMP - fd = mkostemp (tempfile, O_CLOEXEC); -#elif defined HAVE_MKSTEMP - fd = mkstemp (tempfile); -#else - errno = EEXIST; - mktemp (tempfile); - /* INT_MAX denotes success, because close (INT_MAX) does nothing. */ - fd = *tempfile ? INT_MAX : -1; -#endif - if (fd < 0) - report_file_error ("Failed to open temporary file using pattern", - pattern); - emacs_close (fd); - } - - record_unwind_protect (delete_temp_file, filename_string); + fd = mkostemp (tempfile, O_CLOEXEC); + if (fd < 0) + report_file_error ("Failed to open temporary file using pattern", + pattern); + *fdp = fd; + *filename_string_ptr = filename_string; + record_unwind_protect (delete_temp_file_ptr, filename_string_ptr); + record_unwind_protect_ptr (close_file_ptr_unwind, fdp); } start = args[0]; @@ -1058,15 +1013,18 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args) /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we happen to get a ".Z" suffix. */ specbind (intern ("file-name-handler-alist"), Qnil); - Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil); + write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd); unbind_to (count1, Qnil); } + if (lseek (fd, 0, SEEK_SET) < 0) + report_file_error ("Setting file position", filename_string); + /* Note that Fcall_process takes care of binding coding-system-for-read. */ - RETURN_UNGCPRO (filename_string); + UNGCPRO; } DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, @@ -1097,11 +1055,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r (ptrdiff_t nargs, Lisp_Object *args) { struct gcpro gcpro1; - Lisp_Object infile; + Lisp_Object infile, val; ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object start = args[0]; Lisp_Object end = args[1]; bool empty_input; + int fd; if (STRINGP (start)) empty_input = SCHARS (start) == 0; @@ -1115,7 +1074,17 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r empty_input = XINT (start) == XINT (end); } - infile = empty_input ? Qnil : create_temp_file (nargs, args); + if (!empty_input) + create_temp_file (nargs, args, &infile, &fd); + else + { + infile = Qnil; + fd = emacs_open (NULL_DEVICE, O_RDONLY, 0); + if (fd < 0) + report_file_error ("Opening null device", Qnil); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); + } + GCPRO1 (infile); if (nargs > 3 && !NILP (args[3])) @@ -1133,7 +1102,8 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } args[1] = infile; - RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args))); + val = call_process (nargs, args, &fd, &infile); + RETURN_UNGCPRO (unbind_to (count, val)); } #ifndef WINDOWSNT @@ -1209,23 +1179,21 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, static variables as if the superior had done alloca and will be cleaned up in the usual way. */ { - register char *temp; - size_t i; /* size_t, because ptrdiff_t might overflow here! */ + char *temp; + ptrdiff_t i; i = SBYTES (current_dir); #ifdef MSDOS /* MSDOS must have all environment variables malloc'ed, because low-level libc functions that launch subsidiary processes rely on that. */ - pwd_var = xmalloc (i + 6); + pwd_var = xmalloc (i + 5); #else - pwd_var = alloca (i + 6); + pwd_var = alloca (i + 5); #endif temp = pwd_var + 4; memcpy (pwd_var, "PWD=", 4); - memcpy (temp, SDATA (current_dir), i); - if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP; - temp[i] = 0; + strcpy (temp, SSDATA (current_dir)); #ifndef DOS_NT /* We can't signal an Elisp error here; we're in a vfork. Since @@ -1541,14 +1509,14 @@ init_callproc_1 (void) #ifdef HAVE_NS etc_dir ? etc_dir : #endif - PATH_DATA); + PATH_DATA, 0); Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory)); Vdoc_directory = decode_env_path ("EMACSDOC", #ifdef HAVE_NS etc_dir ? etc_dir : #endif - PATH_DOC); + PATH_DOC, 0); Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory)); /* Check the EMACSPATH environment variable, defaulting to the @@ -1557,10 +1525,10 @@ init_callproc_1 (void) #ifdef HAVE_NS path_exec ? path_exec : #endif - PATH_EXEC); + PATH_EXEC, 0); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); /* FIXME? For ns, path_exec should go at the front? */ - Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); + Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); } /* This is run after init_cmdargs, when Vinstallation_directory is valid. */ @@ -1601,9 +1569,9 @@ init_callproc (void) #ifdef HAVE_NS path_exec ? path_exec : #endif - PATH_EXEC); + PATH_EXEC, 0); Vexec_path = Fcons (tem, Vexec_path); - Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); + Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); } Vexec_directory = Ffile_name_as_directory (tem); @@ -1628,17 +1596,17 @@ init_callproc (void) if (data_dir == 0) { Lisp_Object tem, tem1, srcdir; + Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)); - srcdir = Fexpand_file_name (build_string ("../src/"), - build_string (PATH_DUMPLOADSEARCH)); - tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory); + srcdir = Fexpand_file_name (build_string ("../src/"), lispdir); + + tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory); tem1 = Ffile_exists_p (tem); if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1)) { Lisp_Object newdir; - newdir = Fexpand_file_name (build_string ("../etc/"), - build_string (PATH_DUMPLOADSEARCH)); - tem = Fexpand_file_name (build_string ("GNU"), newdir); + newdir = Fexpand_file_name (build_string ("../etc/"), lispdir); + tem = Fexpand_file_name (build_string ("NEWS"), newdir); tem1 = Ffile_exists_p (tem); if (!NILP (tem1)) Vdata_directory = newdir; @@ -1664,7 +1632,7 @@ init_callproc (void) #ifdef DOS_NT Vshared_game_score_directory = Qnil; #else - Vshared_game_score_directory = build_string (PATH_GAME); + Vshared_game_score_directory = build_unibyte_string (PATH_GAME); if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory))) Vshared_game_score_directory = Qnil; #endif @@ -1685,15 +1653,18 @@ set_initial_environment (void) void syms_of_callproc (void) { +#include "callproc.x" + #ifndef DOS_NT Vtemp_file_name_pattern = build_string ("emacsXXXXXX"); -#elif defined (WINDOWSNT) +#else /* DOS_NT */ Vtemp_file_name_pattern = build_string ("emXXXXXX"); -#else - Vtemp_file_name_pattern = build_string ("detmp.XXX"); #endif staticpro (&Vtemp_file_name_pattern); + synch_process_tempfile = make_number (0); + staticpro (&synch_process_tempfile); + DEFVAR_LISP ("shell-file-name", Vshell_file_name, doc: /* File name to load inferior shells from. Initialized from the SHELL environment variable, or to a system-dependent @@ -1701,7 +1672,11 @@ default if SHELL is not set. */); DEFVAR_LISP ("exec-path", Vexec_path, doc: /* List of directories to search programs to run in subprocesses. -Each element is a string (directory name) or nil (try default directory). */); +Each element is a string (directory name) or nil (try default directory). + +By default the last element of this list is `exec-directory'. The +last element is not always used, for example in shell completion +(`shell-dynamic-complete-command'). */); DEFVAR_LISP ("exec-suffixes", Vexec_suffixes, doc: /* List of suffixes to try to find executable file names. @@ -1765,8 +1740,4 @@ use. See `setenv' and `getenv'. */); Vprocess_environment = Qnil; - - defsubr (&Scall_process); - defsubr (&Sgetenv_internal); - defsubr (&Scall_process_region); }