diff options
Diffstat (limited to 'src/callproc.c')
| -rw-r--r-- | src/callproc.c | 211 |
1 files changed, 111 insertions, 100 deletions
diff --git a/src/callproc.c b/src/callproc.c index 30f9dc58d46..91f29bd589b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -123,8 +123,8 @@ record_kill_process (struct Lisp_Process *p) /* Clean up when exiting call_process_cleanup. */ -static Lisp_Object -call_process_kill (Lisp_Object ignored) +static void +call_process_kill (void) { if (synch_process_fd >= 0) emacs_close (synch_process_fd); @@ -136,15 +136,13 @@ call_process_kill (Lisp_Object ignored) proc.pid = synch_process_pid; record_kill_process (&proc); } - - return Qnil; } /* 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. */ -static Lisp_Object +static void call_process_cleanup (Lisp_Object arg) { #ifdef MSDOS @@ -162,7 +160,7 @@ call_process_cleanup (Lisp_Object arg) { ptrdiff_t count = SPECPDL_INDEX (); kill (-synch_process_pid, SIGINT); - record_unwind_protect (call_process_kill, make_number (0)); + 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; @@ -183,8 +181,6 @@ call_process_cleanup (Lisp_Object arg) if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0')) unlink (SDATA (file)); #endif - - return Qnil; } #ifdef DOS_NT @@ -392,7 +388,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (BVAR (current_buffer, directory), Qnil)); + BVAR (current_buffer, directory)); if (STRING_MULTIBYTE (infile)) infile = ENCODE_FILE (infile); @@ -409,8 +405,11 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * filefd = emacs_open (SSDATA (infile), O_RDONLY, 0); if (filefd < 0) - report_file_error ("Opening process input file", - Fcons (DECODE_FILE (infile), Qnil)); + { + int open_errno = errno; + report_file_errno ("Opening process input file", DECODE_FILE (infile), + open_errno); + } if (STRINGP (output_file)) { @@ -422,7 +421,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * int open_errno = errno; output_file = DECODE_FILE (output_file); report_file_errno ("Opening process output file", - Fcons (output_file, Qnil), open_errno); + output_file, open_errno); } if (STRINGP (error_file) || NILP (error_file)) output_to_buffer = 0; @@ -440,8 +439,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { int openp_errno = errno; emacs_close (filefd); - report_file_errno ("Searching for program", - Fcons (args[0], Qnil), openp_errno); + report_file_errno ("Searching for program", args[0], openp_errno); } } @@ -506,7 +504,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * int open_errno = errno; emacs_close (filefd); report_file_errno ("Opening process output file", - Fcons (build_string (tempfile), Qnil), open_errno); + build_string (tempfile), open_errno); } } else @@ -524,7 +522,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { #ifndef MSDOS int fd[2]; - if (pipe2 (fd, O_CLOEXEC) != 0) + if (emacs_pipe (fd) != 0) { int pipe_errno = errno; emacs_close (filefd); @@ -563,8 +561,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * error_file = build_string (NULL_DEVICE); else if (STRINGP (error_file)) error_file = DECODE_FILE (error_file); - report_file_errno ("Cannot redirect stderr", - Fcons (error_file, Qnil), open_errno); + report_file_errno ("Cannot redirect stderr", error_file, open_errno); } #ifdef MSDOS /* MW, July 1993 */ @@ -596,8 +593,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * unlink (tempfile); emacs_close (filefd); report_file_errno ("Cannot re-open temporary file", - Fcons (build_string (tempfile), Qnil), - open_errno); + build_string (tempfile), open_errno); } } else @@ -935,7 +931,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * return make_number (WEXITSTATUS (status)); } -static Lisp_Object +static void delete_temp_file (Lisp_Object name) { /* Suppress jka-compr handling, etc. */ @@ -957,44 +953,18 @@ delete_temp_file (Lisp_Object name) internal_delete_file (name); #endif unbind_to (count, Qnil); - return Qnil; } -DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, - 3, MANY, 0, - doc: /* Send text from START to END to a synchronous process running PROGRAM. -The remaining arguments are optional. -Delete the text if fourth arg DELETE is non-nil. - -Insert output in BUFFER before point; t means current buffer; nil for - BUFFER means discard it; 0 means discard and don't wait; and `(:file - FILE)', where FILE is a file name string, means that it should be - written to that file (if the file already exists it is overwritten). -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. - -Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. -Remaining args are passed to PROGRAM at startup as command args. +/* 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. */ -If BUFFER is 0, `call-process-region' 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-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */) - (ptrdiff_t nargs, Lisp_Object *args) +static Lisp_Object +create_temp_file (ptrdiff_t nargs, Lisp_Object *args) { struct gcpro gcpro1; Lisp_Object filename_string; - register Lisp_Object start, end; - ptrdiff_t count = SPECPDL_INDEX (); - /* Qt denotes we have not yet called Ffind_operation_coding_system. */ - Lisp_Object coding_systems; - Lisp_Object val, *args2; - ptrdiff_t i; + Lisp_Object val, start, end; Lisp_Object tmpdir; if (STRINGP (Vtemporary_file_directory)) @@ -1016,9 +986,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } { - USE_SAFE_ALLOCA; Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); - Lisp_Object encoded_tem; char *tempfile; #ifdef WINDOWSNT @@ -1036,39 +1004,30 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } #endif - encoded_tem = ENCODE_FILE (pattern); - tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1); - memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1); - coding_systems = Qt; + filename_string = Fcopy_sequence (ENCODE_FILE (pattern)); + GCPRO1 (filename_string); + tempfile = SSDATA (filename_string); -#if defined HAVE_MKOSTEMP || defined HAVE_MKSTEMP { - int fd, open_errno; + int fd; - block_input (); -# ifdef HAVE_MKOSTEMP +#ifdef HAVE_MKOSTEMP fd = mkostemp (tempfile, O_CLOEXEC); -# else +#elif defined HAVE_MKSTEMP fd = mkstemp (tempfile); -# endif - open_errno = errno; - unblock_input (); +#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_errno ("Failed to open temporary file", - Fcons (build_string (tempfile), Qnil), open_errno); + report_file_error ("Failed to open temporary file using pattern", + pattern); emacs_close (fd); } -#else - errno = EEXIST; - mktemp (tempfile); - if (!*tempfile) - report_file_error ("Failed to open temporary file using pattern", - Fcons (pattern, Qnil)); -#endif - filename_string = build_string (tempfile); - GCPRO1 (filename_string); - SAFE_FREE (); + record_unwind_protect (delete_temp_file, filename_string); } start = args[0]; @@ -1080,10 +1039,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r val = Qraw_text; else { + Lisp_Object coding_systems; + Lisp_Object *args2; USE_SAFE_ALLOCA; SAFE_NALLOCA (args2, 1, nargs + 1); args2[0] = Qcall_process_region; - for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; + memcpy (args2 + 1, args, nargs * sizeof *args); coding_systems = Ffind_operation_coding_system (nargs + 1, args2); val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil; SAFE_FREE (); @@ -1105,7 +1066,57 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r /* Note that Fcall_process takes care of binding coding-system-for-read. */ - record_unwind_protect (delete_temp_file, filename_string); + RETURN_UNGCPRO (filename_string); +} + +DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, + 3, MANY, 0, + doc: /* Send text from START to END to a synchronous process running PROGRAM. +The remaining arguments are optional. +Delete the text if fourth arg DELETE is non-nil. + +Insert output in BUFFER before point; t means current buffer; nil for + BUFFER means discard it; 0 means discard and don't wait; and `(:file + FILE)', where FILE is a file name string, means that it should be + written to that file (if the file already exists it is overwritten). +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. + +Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. +Remaining args are passed to PROGRAM at startup as command args. + +If BUFFER is 0, `call-process-region' 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-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + struct gcpro gcpro1; + Lisp_Object infile; + ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object start = args[0]; + Lisp_Object end = args[1]; + bool empty_input; + + if (STRINGP (start)) + empty_input = SCHARS (start) == 0; + else if (NILP (start)) + empty_input = BEG == Z; + else + { + validate_region (&args[0], &args[1]); + start = args[0]; + end = args[1]; + empty_input = XINT (start) == XINT (end); + } + + infile = empty_input ? Qnil : create_temp_file (nargs, args); + GCPRO1 (infile); if (nargs > 3 && !NILP (args[3])) Fdelete_region (start, end); @@ -1120,7 +1131,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r args[0] = args[2]; nargs = 2; } - args[1] = filename_string; + args[1] = infile; RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args))); } @@ -1185,9 +1196,11 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, #ifdef WINDOWSNT int cpid; HANDLE handles[3]; -#endif /* WINDOWSNT */ +#else + int exec_errno; pid_t pid = getpid (); +#endif /* WINDOWSNT */ /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. @@ -1346,32 +1359,27 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, } #ifndef MSDOS - emacs_close (0); - emacs_close (1); - emacs_close (2); - - /* Redirect file descriptors and clear FD_CLOEXEC on the redirected ones. */ + /* Redirect file descriptors and clear the close-on-exec flag on the + redirected ones. IN, OUT, and ERR are close-on-exec so they + need not be closed explicitly. */ dup2 (in, 0); dup2 (out, 1); dup2 (err, 2); - emacs_close (in); - if (out != in) - emacs_close (out); - if (err != in && err != out) - emacs_close (err); - setpgid (0, 0); tcsetpgrp (0, pid); execve (new_argv[0], new_argv, env); + exec_errno = errno; - /* Don't output the program name here, as it can be arbitrarily long, - and a long write from a vforked child to its parent can cause a - deadlock. */ - emacs_perror ("child process"); + /* Avoid deadlock if the child's perror writes to a full pipe; the + pipe's reader is the parent, but with vfork the parent can't + run until the child exits. Truncate the diagnostic instead. */ + fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK); - _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); + errno = exec_errno; + emacs_perror (new_argv[0]); + _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); #else /* MSDOS */ pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); @@ -1386,7 +1394,8 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, #ifndef WINDOWSNT /* Move the file descriptor FD so that its number is not less than MINFD. - If the file descriptor is moved at all, the original is freed. */ + If the file descriptor is moved at all, the original is closed on MSDOS, + but not elsewhere as the caller will close it anyway. */ static int relocate_fd (int fd, int minfd) { @@ -1400,7 +1409,9 @@ relocate_fd (int fd, int minfd) emacs_perror ("while setting up child"); _exit (EXIT_CANCELED); } +#ifdef MSDOS emacs_close (fd); +#endif return new; } } |