2ce4a7dcc0d2644a08b432ba16c5828a7badd116
[bpt/emacs.git] / src / callproc.c
1 /* Synchronous subprocess invocation for GNU Emacs.
2
3 Copyright (C) 1985-1988, 1993-1995, 1999-2014 Free Software Foundation,
4 Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21
22 #include <config.h>
23 #include <errno.h>
24 #include <stdio.h>
25 #include <sys/types.h>
26 #include <unistd.h>
27
28 #include <sys/file.h>
29 #include <fcntl.h>
30
31 #include "lisp.h"
32
33 #ifdef WINDOWSNT
34 #define NOMINMAX
35 #include <sys/socket.h> /* for fcntl */
36 #include <windows.h>
37 #include "w32.h"
38 #define _P_NOWAIT 1 /* from process.h */
39 #endif
40
41 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
42 #include <sys/stat.h>
43 #include <sys/param.h>
44 #endif /* MSDOS */
45
46 #include "commands.h"
47 #include "character.h"
48 #include "buffer.h"
49 #include "ccl.h"
50 #include "coding.h"
51 #include "composite.h"
52 #include <epaths.h>
53 #include "process.h"
54 #include "syssignal.h"
55 #include "systty.h"
56 #include "syswait.h"
57 #include "blockinput.h"
58 #include "frame.h"
59 #include "termhooks.h"
60
61 #ifdef MSDOS
62 #include "msdos.h"
63 #endif
64
65 #ifdef HAVE_NS
66 #include "nsterm.h"
67 #endif
68
69 /* Pattern used by call-process-region to make temp files. */
70 static Lisp_Object Vtemp_file_name_pattern;
71
72 /* The next two variables are used while record-unwind-protect is in place
73 during call-process for a subprocess for which record_deleted_pid has
74 not yet been called. At other times, synch_process_pid is zero and
75 synch_process_tempfile's contents are irrelevant. Doing this via static
76 C variables is more convenient than putting them into the arguments
77 of record-unwind-protect, as they need to be updated at randomish
78 times in the code, and Lisp cannot always store these values as
79 Emacs integers. It's safe to use static variables here, as the
80 code is never invoked reentrantly. */
81
82 /* If nonzero, a process-ID that has not been reaped. */
83 static pid_t synch_process_pid;
84
85 /* If a string, the name of a temp file that has not been removed. */
86 #ifdef MSDOS
87 static Lisp_Object synch_process_tempfile;
88 #else
89 # define synch_process_tempfile make_number (0)
90 #endif
91
92 /* Indexes of file descriptors that need closing on call_process_kill. */
93 enum
94 {
95 /* The subsidiary process's stdout and stderr. stdin is handled
96 separately, in either Fcall_process_region or create_temp_file. */
97 CALLPROC_STDOUT, CALLPROC_STDERR,
98
99 /* How to read from a pipe (or substitute) from the subsidiary process. */
100 CALLPROC_PIPEREAD,
101
102 /* A bound on the number of file descriptors. */
103 CALLPROC_FDS
104 };
105
106 static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t);
107 \f
108 /* Block SIGCHLD. */
109
110 void
111 block_child_signal (void)
112 {
113 sigset_t blocked;
114 sigemptyset (&blocked);
115 sigaddset (&blocked, SIGCHLD);
116 pthread_sigmask (SIG_BLOCK, &blocked, 0);
117 }
118
119 /* Unblock SIGCHLD. */
120
121 void
122 unblock_child_signal (void)
123 {
124 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
125 }
126
127 /* Return the current buffer's working directory, or the home
128 directory if it's unreachable, as a string suitable for a system call.
129 Signal an error if the result would not be an accessible directory. */
130
131 Lisp_Object
132 encode_current_directory (void)
133 {
134 Lisp_Object dir;
135 struct gcpro gcpro1;
136
137 dir = BVAR (current_buffer, directory);
138 GCPRO1 (dir);
139
140 dir = Funhandled_file_name_directory (dir);
141
142 /* If the file name handler says that dir is unreachable, use
143 a sensible default. */
144 if (NILP (dir))
145 dir = build_string ("~");
146
147 dir = expand_and_dir_to_file (dir, Qnil);
148
149 if (STRING_MULTIBYTE (dir))
150 dir = ENCODE_FILE (dir);
151 if (! file_accessible_directory_p (SSDATA (dir)))
152 report_file_error ("Setting current directory",
153 BVAR (current_buffer, directory));
154
155 RETURN_UNGCPRO (dir);
156 }
157
158 /* If P is reapable, record it as a deleted process and kill it.
159 Do this in a critical section. Unless PID is wedged it will be
160 reaped on receipt of the first SIGCHLD after the critical section. */
161
162 void
163 record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
164 {
165 block_child_signal ();
166
167 if (p->alive)
168 {
169 record_deleted_pid (p->pid, tempfile);
170 p->alive = 0;
171 kill (- p->pid, SIGKILL);
172 }
173
174 unblock_child_signal ();
175 }
176
177 /* Clean up files, file descriptors and processes created by Fcall_process. */
178
179 static void
180 delete_temp_file (Lisp_Object name)
181 {
182 unlink (SSDATA (name));
183 }
184
185 static void
186 call_process_kill (void *ptr)
187 {
188 int *callproc_fd = ptr;
189 int i;
190 for (i = 0; i < CALLPROC_FDS; i++)
191 if (0 <= callproc_fd[i])
192 emacs_close (callproc_fd[i]);
193
194 if (synch_process_pid)
195 {
196 struct Lisp_Process proc;
197 proc.alive = 1;
198 proc.pid = synch_process_pid;
199 record_kill_process (&proc, synch_process_tempfile);
200 synch_process_pid = 0;
201 }
202 else if (STRINGP (synch_process_tempfile))
203 delete_temp_file (synch_process_tempfile);
204 }
205
206 /* Clean up when exiting Fcall_process: restore the buffer, and
207 kill the subsidiary process group if the process still exists. */
208
209 static void
210 call_process_cleanup (Lisp_Object buffer)
211 {
212 Fset_buffer (buffer);
213
214 if (synch_process_pid)
215 {
216 kill (-synch_process_pid, SIGINT);
217 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
218 immediate_quit = 1;
219 QUIT;
220 wait_for_termination (synch_process_pid, 0, 1);
221 synch_process_pid = 0;
222 immediate_quit = 0;
223 message1 ("Waiting for process to die...done");
224 }
225 }
226
227 #ifdef DOS_NT
228 static mode_t const default_output_mode = S_IREAD | S_IWRITE;
229 #else
230 static mode_t const default_output_mode = 0666;
231 #endif
232
233 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
234 doc: /* Call PROGRAM synchronously in separate process.
235 The remaining arguments are optional.
236 The program's input comes from file INFILE (nil means `/dev/null').
237 Insert output in DESTINATION before point; t means current buffer; nil for DESTINATION
238 means discard it; 0 means discard and don't wait; and `(:file FILE)', where
239 FILE is a file name string, means that it should be written to that file
240 \(if the file already exists it is overwritten).
241 DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
242 REAL-BUFFER says what to do with standard output, as above,
243 while STDERR-FILE says what to do with standard error in the child.
244 STDERR-FILE may be nil (discard standard error output),
245 t (mix it with ordinary output), or a file name string.
246
247 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
248 Remaining arguments are strings passed as command arguments to PROGRAM.
249
250 If executable PROGRAM can't be found as an executable, `call-process'
251 signals a Lisp error. `call-process' reports errors in execution of
252 the program only through its return and output.
253
254 If DESTINATION is 0, `call-process' returns immediately with value nil.
255 Otherwise it waits for PROGRAM to terminate
256 and returns a numeric exit status or a signal description string.
257 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
258
259 usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) */)
260 (ptrdiff_t nargs, Lisp_Object *args)
261 {
262 Lisp_Object infile, encoded_infile;
263 int filefd;
264 struct gcpro gcpro1;
265 ptrdiff_t count = SPECPDL_INDEX ();
266
267 if (nargs >= 2 && ! NILP (args[1]))
268 {
269 infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
270 CHECK_STRING (infile);
271 }
272 else
273 infile = build_string (NULL_DEVICE);
274
275 GCPRO1 (infile);
276 encoded_infile = STRING_MULTIBYTE (infile) ? ENCODE_FILE (infile) : infile;
277
278 filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
279 if (filefd < 0)
280 report_file_error ("Opening process input file", infile);
281 record_unwind_protect_int (close_file_unwind, filefd);
282 UNGCPRO;
283 return unbind_to (count, call_process (nargs, args, filefd, -1));
284 }
285
286 /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
287
288 If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an
289 unwinder that is intended to remove the input temporary file; in
290 this case NARGS must be at least 2 and ARGS[1] is the file's name.
291
292 At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */
293
294 static Lisp_Object
295 call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
296 ptrdiff_t tempfile_index)
297 {
298 Lisp_Object buffer, current_dir, path;
299 bool display_p;
300 int fd0;
301 int callproc_fd[CALLPROC_FDS];
302 int status;
303 ptrdiff_t i;
304 ptrdiff_t count = SPECPDL_INDEX ();
305 USE_SAFE_ALLOCA;
306
307 char **new_argv;
308 /* File to use for stderr in the child.
309 t means use same as standard output. */
310 Lisp_Object error_file;
311 Lisp_Object output_file = Qnil;
312 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
313 char *tempfile = NULL;
314 int pid;
315 #else
316 pid_t pid;
317 #endif
318 int child_errno;
319 int fd_output, fd_error;
320 struct coding_system process_coding; /* coding-system of process output */
321 struct coding_system argument_coding; /* coding-system of arguments */
322 /* Set to the return value of Ffind_operation_coding_system. */
323 Lisp_Object coding_systems;
324 bool discard_output;
325
326 if (synch_process_pid)
327 error ("call-process invoked recursively");
328
329 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
330 coding_systems = Qt;
331
332 CHECK_STRING (args[0]);
333
334 error_file = Qt;
335
336 #ifndef subprocesses
337 /* Without asynchronous processes we cannot have BUFFER == 0. */
338 if (nargs >= 3
339 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
340 error ("Operating system cannot handle asynchronous subprocesses");
341 #endif /* subprocesses */
342
343 /* Decide the coding-system for giving arguments. */
344 {
345 Lisp_Object val, *args2;
346
347 /* If arguments are supplied, we may have to encode them. */
348 if (nargs >= 5)
349 {
350 bool must_encode = 0;
351 Lisp_Object coding_attrs;
352
353 for (i = 4; i < nargs; i++)
354 CHECK_STRING (args[i]);
355
356 for (i = 4; i < nargs; i++)
357 if (STRING_MULTIBYTE (args[i]))
358 must_encode = 1;
359
360 if (!NILP (Vcoding_system_for_write))
361 val = Vcoding_system_for_write;
362 else if (! must_encode)
363 val = Qraw_text;
364 else
365 {
366 SAFE_NALLOCA (args2, 1, nargs + 1);
367 args2[0] = Qcall_process;
368 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
369 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
370 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
371 }
372 val = complement_process_encoding_system (val);
373 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
374 coding_attrs = CODING_ID_ATTRS (argument_coding.id);
375 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
376 {
377 /* We should not use an ASCII incompatible coding system. */
378 val = raw_text_coding_system (val);
379 setup_coding_system (val, &argument_coding);
380 }
381 }
382 }
383
384 if (nargs < 3)
385 buffer = Qnil;
386 else
387 {
388 buffer = args[2];
389
390 /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
391 FILE-FOR-STDERR), unless the first element is :file, in which case see
392 the next paragraph. */
393 if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
394 {
395 if (CONSP (XCDR (buffer)))
396 {
397 Lisp_Object stderr_file;
398 stderr_file = XCAR (XCDR (buffer));
399
400 if (NILP (stderr_file) || EQ (Qt, stderr_file))
401 error_file = stderr_file;
402 else
403 error_file = Fexpand_file_name (stderr_file, Qnil);
404 }
405
406 buffer = XCAR (buffer);
407 }
408
409 /* If the buffer is (still) a list, it might be a (:file "file") spec. */
410 if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
411 {
412 output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
413 BVAR (current_buffer, directory));
414 CHECK_STRING (output_file);
415 buffer = Qnil;
416 }
417
418 if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer)))
419 {
420 Lisp_Object spec_buffer;
421 spec_buffer = buffer;
422 buffer = Fget_buffer_create (buffer);
423 /* Mention the buffer name for a better error message. */
424 if (NILP (buffer))
425 CHECK_BUFFER (spec_buffer);
426 CHECK_BUFFER (buffer);
427 }
428 }
429
430 /* Make sure that the child will be able to chdir to the current
431 buffer's current directory, or its unhandled equivalent. We
432 can't just have the child check for an error when it does the
433 chdir, since it's in a vfork.
434
435 We have to GCPRO around this because Fexpand_file_name,
436 Funhandled_file_name_directory, and Ffile_accessible_directory_p
437 might call a file name handling function. The argument list is
438 protected by the caller, so all we really have to worry about is
439 buffer. */
440 {
441 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
442
443 current_dir = encode_current_directory ();
444
445 GCPRO4 (buffer, current_dir, error_file, output_file);
446
447 if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
448 error_file = ENCODE_FILE (error_file);
449 if (STRINGP (output_file) && STRING_MULTIBYTE (output_file))
450 output_file = ENCODE_FILE (output_file);
451 UNGCPRO;
452 }
453
454 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
455
456 for (i = 0; i < CALLPROC_FDS; i++)
457 callproc_fd[i] = -1;
458 #ifdef MSDOS
459 synch_process_tempfile = make_number (0);
460 #endif
461 record_unwind_protect_ptr (call_process_kill, callproc_fd);
462
463 /* Search for program; barf if not found. */
464 {
465 struct gcpro gcpro1, gcpro2, gcpro3;
466 int ok;
467
468 GCPRO3 (buffer, current_dir, error_file);
469 ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
470 make_number (X_OK), false);
471 UNGCPRO;
472 if (ok < 0)
473 report_file_error ("Searching for program", args[0]);
474 }
475
476 /* If program file name starts with /: for quoting a magic name,
477 discard that. */
478 if (SBYTES (path) > 2 && SREF (path, 0) == '/'
479 && SREF (path, 1) == ':')
480 path = Fsubstring (path, make_number (2), Qnil);
481
482 new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
483
484 {
485 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
486
487 GCPRO4 (buffer, current_dir, path, error_file);
488 if (nargs > 4)
489 {
490 ptrdiff_t i;
491
492 argument_coding.dst_multibyte = 0;
493 for (i = 4; i < nargs; i++)
494 {
495 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
496 if (CODING_REQUIRE_ENCODING (&argument_coding))
497 /* We must encode this argument. */
498 args[i] = encode_coding_string (&argument_coding, args[i], 1);
499 }
500 for (i = 4; i < nargs; i++)
501 new_argv[i - 3] = SSDATA (args[i]);
502 new_argv[i - 3] = 0;
503 }
504 else
505 new_argv[1] = 0;
506 if (STRING_MULTIBYTE (path))
507 path = ENCODE_FILE (path);
508 new_argv[0] = SSDATA (path);
509 UNGCPRO;
510 }
511
512 discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file));
513
514 #ifdef MSDOS
515 if (! discard_output && ! STRINGP (output_file))
516 {
517 char const *tmpdir = egetenv ("TMPDIR");
518 char const *outf = tmpdir ? tmpdir : "";
519 tempfile = alloca (strlen (outf) + 20);
520 strcpy (tempfile, outf);
521 dostounix_filename (tempfile, 0);
522 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
523 strcat (tempfile, "/");
524 strcat (tempfile, "detmp.XXX");
525 mktemp (tempfile);
526 if (!*tempfile)
527 report_file_error ("Opening process output file", Qnil);
528 output_file = build_string (tempfile);
529 synch_process_tempfile = output_file;
530 }
531 #endif
532
533 if (discard_output)
534 {
535 fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
536 if (fd_output < 0)
537 report_file_error ("Opening null device", Qnil);
538 }
539 else if (STRINGP (output_file))
540 {
541 fd_output = emacs_open (SSDATA (output_file),
542 O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
543 default_output_mode);
544 if (fd_output < 0)
545 {
546 int open_errno = errno;
547 output_file = DECODE_FILE (output_file);
548 report_file_errno ("Opening process output file",
549 output_file, open_errno);
550 }
551 }
552 else
553 {
554 int fd[2];
555 if (emacs_pipe (fd) != 0)
556 report_file_error ("Creating process pipe", Qnil);
557 callproc_fd[CALLPROC_PIPEREAD] = fd[0];
558 fd_output = fd[1];
559 }
560 callproc_fd[CALLPROC_STDOUT] = fd_output;
561
562 fd_error = fd_output;
563
564 if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
565 {
566 fd_error = emacs_open ((STRINGP (error_file)
567 ? SSDATA (error_file)
568 : NULL_DEVICE),
569 O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
570 default_output_mode);
571 if (fd_error < 0)
572 {
573 int open_errno = errno;
574 report_file_errno ("Cannot redirect stderr",
575 (STRINGP (error_file)
576 ? DECODE_FILE (error_file)
577 : build_string (NULL_DEVICE)),
578 open_errno);
579 }
580 callproc_fd[CALLPROC_STDERR] = fd_error;
581 }
582
583 #ifdef MSDOS /* MW, July 1993 */
584 /* Note that on MSDOS `child_setup' actually returns the child process
585 exit status, not its PID, so assign it to status below. */
586 pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
587
588 if (pid < 0)
589 {
590 child_errno = errno;
591 unbind_to (count, Qnil);
592 synchronize_system_messages_locale ();
593 return
594 code_convert_string_norecord (build_string (strerror (child_errno)),
595 Vlocale_coding_system, 0);
596 }
597 status = pid;
598
599 for (i = 0; i < CALLPROC_FDS; i++)
600 if (0 <= callproc_fd[i])
601 {
602 emacs_close (callproc_fd[i]);
603 callproc_fd[i] = -1;
604 }
605 emacs_close (filefd);
606 clear_unwind_protect (count - 1);
607
608 if (tempfile)
609 {
610 /* Since CRLF is converted to LF within `decode_coding', we
611 can always open a file with binary mode. */
612 callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile,
613 O_RDONLY | O_BINARY, 0);
614 if (callproc_fd[CALLPROC_PIPEREAD] < 0)
615 {
616 int open_errno = errno;
617 report_file_errno ("Cannot re-open temporary file",
618 build_string (tempfile), open_errno);
619 }
620 }
621
622 #endif /* MSDOS */
623
624 /* Do the unwind-protect now, even though the pid is not known, so
625 that no storage allocation is done in the critical section.
626 The actual PID will be filled in during the critical section. */
627 record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
628
629 #ifndef MSDOS
630
631 block_input ();
632 block_child_signal ();
633
634 #ifdef WINDOWSNT
635 pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
636 #else /* not WINDOWSNT */
637
638 /* vfork, and prevent local vars from being clobbered by the vfork. */
639 {
640 Lisp_Object volatile buffer_volatile = buffer;
641 Lisp_Object volatile coding_systems_volatile = coding_systems;
642 Lisp_Object volatile current_dir_volatile = current_dir;
643 bool volatile display_p_volatile = display_p;
644 bool volatile sa_must_free_volatile = sa_must_free;
645 int volatile fd_error_volatile = fd_error;
646 int volatile filefd_volatile = filefd;
647 ptrdiff_t volatile count_volatile = count;
648 ptrdiff_t volatile sa_count_volatile = sa_count;
649 char **volatile new_argv_volatile = new_argv;
650 int volatile callproc_fd_volatile[CALLPROC_FDS];
651 for (i = 0; i < CALLPROC_FDS; i++)
652 callproc_fd_volatile[i] = callproc_fd[i];
653
654 pid = vfork ();
655
656 buffer = buffer_volatile;
657 coding_systems = coding_systems_volatile;
658 current_dir = current_dir_volatile;
659 display_p = display_p_volatile;
660 sa_must_free = sa_must_free_volatile;
661 fd_error = fd_error_volatile;
662 filefd = filefd_volatile;
663 count = count_volatile;
664 sa_count = sa_count_volatile;
665 new_argv = new_argv_volatile;
666
667 for (i = 0; i < CALLPROC_FDS; i++)
668 callproc_fd[i] = callproc_fd_volatile[i];
669 fd_output = callproc_fd[CALLPROC_STDOUT];
670 }
671
672 if (pid == 0)
673 {
674 unblock_child_signal ();
675
676 setsid ();
677
678 /* Emacs ignores SIGPIPE, but the child should not. */
679 signal (SIGPIPE, SIG_DFL);
680 /* Likewise for SIGPROF. */
681 #ifdef SIGPROF
682 signal (SIGPROF, SIG_DFL);
683 #endif
684
685 child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
686 }
687
688 #endif /* not WINDOWSNT */
689
690 child_errno = errno;
691
692 if (pid > 0)
693 {
694 synch_process_pid = pid;
695
696 if (INTEGERP (buffer))
697 {
698 if (tempfile_index < 0)
699 record_deleted_pid (pid, Qnil);
700 else
701 {
702 eassert (1 < nargs);
703 record_deleted_pid (pid, args[1]);
704 clear_unwind_protect (tempfile_index);
705 }
706 synch_process_pid = 0;
707 }
708 }
709
710 unblock_child_signal ();
711 unblock_input ();
712
713 #endif /* not MSDOS */
714
715 if (pid < 0)
716 report_file_errno ("Doing vfork", Qnil, child_errno);
717
718 /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
719 since we will use that to read input from. */
720 for (i = 0; i < CALLPROC_FDS; i++)
721 if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
722 {
723 emacs_close (callproc_fd[i]);
724 callproc_fd[i] = -1;
725 }
726 emacs_close (filefd);
727 clear_unwind_protect (count - 1);
728
729 if (INTEGERP (buffer))
730 return unbind_to (count, Qnil);
731
732 if (BUFFERP (buffer))
733 Fset_buffer (buffer);
734
735 fd0 = callproc_fd[CALLPROC_PIPEREAD];
736
737 if (0 <= fd0)
738 {
739 Lisp_Object val, *args2;
740
741 val = Qnil;
742 if (!NILP (Vcoding_system_for_read))
743 val = Vcoding_system_for_read;
744 else
745 {
746 if (EQ (coding_systems, Qt))
747 {
748 ptrdiff_t i;
749
750 SAFE_NALLOCA (args2, 1, nargs + 1);
751 args2[0] = Qcall_process;
752 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
753 coding_systems
754 = Ffind_operation_coding_system (nargs + 1, args2);
755 }
756 if (CONSP (coding_systems))
757 val = XCAR (coding_systems);
758 else if (CONSP (Vdefault_process_coding_system))
759 val = XCAR (Vdefault_process_coding_system);
760 else
761 val = Qnil;
762 }
763 Fcheck_coding_system (val);
764 /* In unibyte mode, character code conversion should not take
765 place but EOL conversion should. So, setup raw-text or one
766 of the subsidiary according to the information just setup. */
767 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
768 && !NILP (val))
769 val = raw_text_coding_system (val);
770 setup_coding_system (val, &process_coding);
771 process_coding.dst_multibyte
772 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
773 process_coding.src_multibyte = 0;
774 }
775
776 immediate_quit = 1;
777 QUIT;
778
779 if (0 <= fd0)
780 {
781 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
782 enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
783 char buf[CALLPROC_BUFFER_SIZE_MAX];
784 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
785 int nread;
786 EMACS_INT total_read = 0;
787 int carryover = 0;
788 bool display_on_the_fly = display_p;
789 struct coding_system saved_coding = process_coding;
790
791 while (1)
792 {
793 /* Repeatedly read until we've filled as much as possible
794 of the buffer size we have. But don't read
795 less than 1024--save that for the next bufferful. */
796 nread = carryover;
797 while (nread < bufsize - 1024)
798 {
799 int this_read = emacs_read (fd0, buf + nread,
800 bufsize - nread);
801
802 if (this_read < 0)
803 goto give_up;
804
805 if (this_read == 0)
806 {
807 process_coding.mode |= CODING_MODE_LAST_BLOCK;
808 break;
809 }
810
811 nread += this_read;
812 total_read += this_read;
813
814 if (display_on_the_fly)
815 break;
816 }
817
818 /* Now NREAD is the total amount of data in the buffer. */
819 immediate_quit = 0;
820
821 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
822 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
823 insert_1_both (buf, nread, nread, 0, 1, 0);
824 else
825 { /* We have to decode the input. */
826 Lisp_Object curbuf;
827 ptrdiff_t count1 = SPECPDL_INDEX ();
828
829 XSETBUFFER (curbuf, current_buffer);
830 prepare_to_modify_buffer (PT, PT, NULL);
831 /* We cannot allow after-change-functions be run
832 during decoding, because that might modify the
833 buffer, while we rely on process_coding.produced to
834 faithfully reflect inserted text until we
835 TEMP_SET_PT_BOTH below. */
836 specbind (Qinhibit_modification_hooks, Qt);
837 decode_coding_c_string (&process_coding,
838 (unsigned char *) buf, nread, curbuf);
839 unbind_to (count1, Qnil);
840 if (display_on_the_fly
841 && CODING_REQUIRE_DETECTION (&saved_coding)
842 && ! CODING_REQUIRE_DETECTION (&process_coding))
843 {
844 /* We have detected some coding system, but the
845 detection may have been via insufficient data.
846 So give up displaying on the fly. */
847 if (process_coding.produced > 0)
848 del_range_2 (process_coding.dst_pos,
849 process_coding.dst_pos_byte,
850 (process_coding.dst_pos
851 + process_coding.produced_char),
852 (process_coding.dst_pos_byte
853 + process_coding.produced),
854 0);
855 display_on_the_fly = 0;
856 process_coding = saved_coding;
857 carryover = nread;
858 /* Make the above condition always fail in the future. */
859 saved_coding.common_flags
860 &= ~CODING_REQUIRE_DETECTION_MASK;
861 continue;
862 }
863
864 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
865 PT_BYTE + process_coding.produced);
866 carryover = process_coding.carryover_bytes;
867 if (carryover > 0)
868 memcpy (buf, process_coding.carryover,
869 process_coding.carryover_bytes);
870 }
871
872 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
873 break;
874
875 /* Make the buffer bigger as we continue to read more data,
876 but not past CALLPROC_BUFFER_SIZE_MAX. */
877 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
878 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
879 bufsize = CALLPROC_BUFFER_SIZE_MAX;
880
881 if (display_p)
882 {
883 redisplay_preserve_echo_area (1);
884 /* This variable might have been set to 0 for code
885 detection. In that case, set it back to 1 because
886 we should have already detected a coding system. */
887 display_on_the_fly = 1;
888 }
889 immediate_quit = 1;
890 QUIT;
891 }
892 give_up: ;
893
894 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
895 /* If the caller required, let the buffer inherit the
896 coding-system used to decode the process output. */
897 if (inherit_process_coding_system)
898 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
899 make_number (total_read));
900 }
901
902 #ifndef MSDOS
903 /* Wait for it to terminate, unless it already has. */
904 wait_for_termination (pid, &status, fd0 < 0);
905 #endif
906
907 immediate_quit = 0;
908
909 /* Don't kill any children that the subprocess may have left behind
910 when exiting. */
911 synch_process_pid = 0;
912
913 SAFE_FREE ();
914 unbind_to (count, Qnil);
915
916 if (WIFSIGNALED (status))
917 {
918 const char *signame;
919
920 synchronize_system_messages_locale ();
921 signame = strsignal (WTERMSIG (status));
922
923 if (signame == 0)
924 signame = "unknown";
925
926 return code_convert_string_norecord (build_string (signame),
927 Vlocale_coding_system, 0);
928 }
929
930 eassert (WIFEXITED (status));
931 return make_number (WEXITSTATUS (status));
932 }
933 \f
934 /* Create a temporary file suitable for storing the input data of
935 call-process-region. NARGS and ARGS are the same as for
936 call-process-region. Store into *FILENAME_STRING_PTR a Lisp string
937 naming the file, and return a file descriptor for reading.
938 Unwind-protect the file, so that the file descriptor will be closed
939 and the file removed when the caller unwinds the specpdl stack. */
940
941 static int
942 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
943 Lisp_Object *filename_string_ptr)
944 {
945 int fd;
946 struct gcpro gcpro1;
947 Lisp_Object filename_string;
948 Lisp_Object val, start, end;
949 Lisp_Object tmpdir;
950
951 if (STRINGP (Vtemporary_file_directory))
952 tmpdir = Vtemporary_file_directory;
953 else
954 {
955 char *outf;
956 #ifndef DOS_NT
957 outf = getenv ("TMPDIR");
958 tmpdir = build_string (outf ? outf : "/tmp/");
959 #else /* DOS_NT */
960 if ((outf = egetenv ("TMPDIR"))
961 || (outf = egetenv ("TMP"))
962 || (outf = egetenv ("TEMP")))
963 tmpdir = build_string (outf);
964 else
965 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
966 #endif
967 }
968
969 {
970 Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
971 char *tempfile;
972 ptrdiff_t count;
973
974 #ifdef WINDOWSNT
975 /* Cannot use the result of Fexpand_file_name, because it
976 downcases the XXXXXX part of the pattern, and mktemp then
977 doesn't recognize it. */
978 if (!NILP (Vw32_downcase_file_names))
979 {
980 Lisp_Object dirname = Ffile_name_directory (pattern);
981
982 if (NILP (dirname))
983 pattern = Vtemp_file_name_pattern;
984 else
985 pattern = concat2 (dirname, Vtemp_file_name_pattern);
986 }
987 #endif
988
989 filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
990 GCPRO1 (filename_string);
991 tempfile = SSDATA (filename_string);
992
993 count = SPECPDL_INDEX ();
994 record_unwind_protect_nothing ();
995 fd = mkostemp (tempfile, O_CLOEXEC);
996 if (fd < 0)
997 report_file_error ("Failed to open temporary file using pattern",
998 pattern);
999 set_unwind_protect (count, delete_temp_file, filename_string);
1000 record_unwind_protect_int (close_file_unwind, fd);
1001 }
1002
1003 start = args[0];
1004 end = args[1];
1005 /* Decide coding-system of the contents of the temporary file. */
1006 if (!NILP (Vcoding_system_for_write))
1007 val = Vcoding_system_for_write;
1008 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1009 val = Qraw_text;
1010 else
1011 {
1012 Lisp_Object coding_systems;
1013 Lisp_Object *args2;
1014 USE_SAFE_ALLOCA;
1015 SAFE_NALLOCA (args2, 1, nargs + 1);
1016 args2[0] = Qcall_process_region;
1017 memcpy (args2 + 1, args, nargs * sizeof *args);
1018 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1019 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
1020 SAFE_FREE ();
1021 }
1022 val = complement_process_encoding_system (val);
1023
1024 {
1025 ptrdiff_t count1 = SPECPDL_INDEX ();
1026
1027 specbind (intern ("coding-system-for-write"), val);
1028 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1029 happen to get a ".Z" suffix. */
1030 specbind (intern ("file-name-handler-alist"), Qnil);
1031 write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
1032
1033 unbind_to (count1, Qnil);
1034 }
1035
1036 if (lseek (fd, 0, SEEK_SET) < 0)
1037 report_file_error ("Setting file position", filename_string);
1038
1039 /* Note that Fcall_process takes care of binding
1040 coding-system-for-read. */
1041
1042 *filename_string_ptr = filename_string;
1043 UNGCPRO;
1044 return fd;
1045 }
1046
1047 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
1048 3, MANY, 0,
1049 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1050 The remaining arguments are optional.
1051 Delete the text if fourth arg DELETE is non-nil.
1052
1053 Insert output in BUFFER before point; t means current buffer; nil for
1054 BUFFER means discard it; 0 means discard and don't wait; and `(:file
1055 FILE)', where FILE is a file name string, means that it should be
1056 written to that file (if the file already exists it is overwritten).
1057 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1058 REAL-BUFFER says what to do with standard output, as above,
1059 while STDERR-FILE says what to do with standard error in the child.
1060 STDERR-FILE may be nil (discard standard error output),
1061 t (mix it with ordinary output), or a file name string.
1062
1063 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1064 Remaining args are passed to PROGRAM at startup as command args.
1065
1066 If BUFFER is 0, `call-process-region' returns immediately with value nil.
1067 Otherwise it waits for PROGRAM to terminate
1068 and returns a numeric exit status or a signal description string.
1069 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1070
1071 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
1072 (ptrdiff_t nargs, Lisp_Object *args)
1073 {
1074 struct gcpro gcpro1;
1075 Lisp_Object infile, val;
1076 ptrdiff_t count = SPECPDL_INDEX ();
1077 Lisp_Object start = args[0];
1078 Lisp_Object end = args[1];
1079 bool empty_input;
1080 int fd;
1081
1082 if (STRINGP (start))
1083 empty_input = SCHARS (start) == 0;
1084 else if (NILP (start))
1085 empty_input = BEG == Z;
1086 else
1087 {
1088 validate_region (&args[0], &args[1]);
1089 start = args[0];
1090 end = args[1];
1091 empty_input = XINT (start) == XINT (end);
1092 }
1093
1094 if (!empty_input)
1095 fd = create_temp_file (nargs, args, &infile);
1096 else
1097 {
1098 infile = Qnil;
1099 fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
1100 if (fd < 0)
1101 report_file_error ("Opening null device", Qnil);
1102 record_unwind_protect_int (close_file_unwind, fd);
1103 }
1104
1105 GCPRO1 (infile);
1106
1107 if (nargs > 3 && !NILP (args[3]))
1108 Fdelete_region (start, end);
1109
1110 if (nargs > 3)
1111 {
1112 args += 2;
1113 nargs -= 2;
1114 }
1115 else
1116 {
1117 args[0] = args[2];
1118 nargs = 2;
1119 }
1120 args[1] = infile;
1121
1122 val = call_process (nargs, args, fd, empty_input ? -1 : count);
1123 RETURN_UNGCPRO (unbind_to (count, val));
1124 }
1125 \f
1126 #ifndef WINDOWSNT
1127 static int relocate_fd (int fd, int minfd);
1128 #endif
1129
1130 static char **
1131 add_env (char **env, char **new_env, char *string)
1132 {
1133 char **ep;
1134 bool ok = 1;
1135 if (string == NULL)
1136 return new_env;
1137
1138 /* See if this string duplicates any string already in the env.
1139 If so, don't put it in.
1140 When an env var has multiple definitions,
1141 we keep the definition that comes first in process-environment. */
1142 for (ep = env; ok && ep != new_env; ep++)
1143 {
1144 char *p = *ep, *q = string;
1145 while (ok)
1146 {
1147 if (*q != *p)
1148 break;
1149 if (*q == 0)
1150 /* The string is a lone variable name; keep it for now, we
1151 will remove it later. It is a placeholder for a
1152 variable that is not to be included in the environment. */
1153 break;
1154 if (*q == '=')
1155 ok = 0;
1156 p++, q++;
1157 }
1158 }
1159 if (ok)
1160 *new_env++ = string;
1161 return new_env;
1162 }
1163
1164 /* This is the last thing run in a newly forked inferior
1165 either synchronous or asynchronous.
1166 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1167 Initialize inferior's priority, pgrp, connected dir and environment.
1168 then exec another program based on new_argv.
1169
1170 If SET_PGRP, put the subprocess into a separate process group.
1171
1172 CURRENT_DIR is an elisp string giving the path of the current
1173 directory the subprocess should have. Since we can't really signal
1174 a decent error from within the child, this should be verified as an
1175 executable directory by the parent. */
1176
1177 int
1178 child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
1179 Lisp_Object current_dir)
1180 {
1181 char **env;
1182 char *pwd_var;
1183 #ifdef WINDOWSNT
1184 int cpid;
1185 HANDLE handles[3];
1186 #else
1187 int exec_errno;
1188
1189 pid_t pid = getpid ();
1190 #endif /* WINDOWSNT */
1191
1192 /* Note that use of alloca is always safe here. It's obvious for systems
1193 that do not have true vfork or that have true (stack) alloca.
1194 If using vfork and C_ALLOCA (when Emacs used to include
1195 src/alloca.c) it is safe because that changes the superior's
1196 static variables as if the superior had done alloca and will be
1197 cleaned up in the usual way. */
1198 {
1199 char *temp;
1200 ptrdiff_t i;
1201
1202 i = SBYTES (current_dir);
1203 #ifdef MSDOS
1204 /* MSDOS must have all environment variables malloc'ed, because
1205 low-level libc functions that launch subsidiary processes rely
1206 on that. */
1207 pwd_var = xmalloc (i + 5);
1208 #else
1209 pwd_var = alloca (i + 5);
1210 #endif
1211 temp = pwd_var + 4;
1212 memcpy (pwd_var, "PWD=", 4);
1213 strcpy (temp, SSDATA (current_dir));
1214
1215 #ifndef DOS_NT
1216 /* We can't signal an Elisp error here; we're in a vfork. Since
1217 the callers check the current directory before forking, this
1218 should only return an error if the directory's permissions
1219 are changed between the check and this chdir, but we should
1220 at least check. */
1221 if (chdir (temp) < 0)
1222 _exit (EXIT_CANCELED);
1223 #else /* DOS_NT */
1224 /* Get past the drive letter, so that d:/ is left alone. */
1225 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1226 {
1227 temp += 2;
1228 i -= 2;
1229 }
1230 #endif /* DOS_NT */
1231
1232 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1233 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1234 temp[--i] = 0;
1235 }
1236
1237 /* Set `env' to a vector of the strings in the environment. */
1238 {
1239 register Lisp_Object tem;
1240 register char **new_env;
1241 char **p, **q;
1242 register int new_length;
1243 Lisp_Object display = Qnil;
1244
1245 new_length = 0;
1246
1247 for (tem = Vprocess_environment;
1248 CONSP (tem) && STRINGP (XCAR (tem));
1249 tem = XCDR (tem))
1250 {
1251 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1252 && (SDATA (XCAR (tem)) [7] == '\0'
1253 || SDATA (XCAR (tem)) [7] == '='))
1254 /* DISPLAY is specified in process-environment. */
1255 display = Qt;
1256 new_length++;
1257 }
1258
1259 /* If not provided yet, use the frame's DISPLAY. */
1260 if (NILP (display))
1261 {
1262 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1263 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1264 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1265 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1266 Vinitial_environment);
1267 if (STRINGP (tmp))
1268 {
1269 display = tmp;
1270 new_length++;
1271 }
1272 }
1273
1274 /* new_length + 2 to include PWD and terminating 0. */
1275 env = new_env = alloca ((new_length + 2) * sizeof *env);
1276 /* If we have a PWD envvar, pass one down,
1277 but with corrected value. */
1278 if (egetenv ("PWD"))
1279 *new_env++ = pwd_var;
1280
1281 if (STRINGP (display))
1282 {
1283 char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
1284 strcpy (vdata, "DISPLAY=");
1285 strcat (vdata, SSDATA (display));
1286 new_env = add_env (env, new_env, vdata);
1287 }
1288
1289 /* Overrides. */
1290 for (tem = Vprocess_environment;
1291 CONSP (tem) && STRINGP (XCAR (tem));
1292 tem = XCDR (tem))
1293 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1294
1295 *new_env = 0;
1296
1297 /* Remove variable names without values. */
1298 p = q = env;
1299 while (*p != 0)
1300 {
1301 while (*q != 0 && strchr (*q, '=') == NULL)
1302 q++;
1303 *p = *q++;
1304 if (*p != 0)
1305 p++;
1306 }
1307 }
1308
1309
1310 #ifdef WINDOWSNT
1311 prepare_standard_handles (in, out, err, handles);
1312 set_process_dir (SDATA (current_dir));
1313 /* Spawn the child. (See w32proc.c:sys_spawnve). */
1314 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1315 reset_standard_handles (in, out, err, handles);
1316 if (cpid == -1)
1317 /* An error occurred while trying to spawn the process. */
1318 report_file_error ("Spawning child process", Qnil);
1319 return cpid;
1320
1321 #else /* not WINDOWSNT */
1322 /* Make sure that in, out, and err are not actually already in
1323 descriptors zero, one, or two; this could happen if Emacs is
1324 started with its standard in, out, or error closed, as might
1325 happen under X. */
1326 {
1327 int oin = in, oout = out;
1328
1329 /* We have to avoid relocating the same descriptor twice! */
1330
1331 in = relocate_fd (in, 3);
1332
1333 if (out == oin)
1334 out = in;
1335 else
1336 out = relocate_fd (out, 3);
1337
1338 if (err == oin)
1339 err = in;
1340 else if (err == oout)
1341 err = out;
1342 else
1343 err = relocate_fd (err, 3);
1344 }
1345
1346 #ifndef MSDOS
1347 /* Redirect file descriptors and clear the close-on-exec flag on the
1348 redirected ones. IN, OUT, and ERR are close-on-exec so they
1349 need not be closed explicitly. */
1350 dup2 (in, 0);
1351 dup2 (out, 1);
1352 dup2 (err, 2);
1353
1354 setpgid (0, 0);
1355 tcsetpgrp (0, pid);
1356
1357 execve (new_argv[0], new_argv, env);
1358 exec_errno = errno;
1359
1360 /* Avoid deadlock if the child's perror writes to a full pipe; the
1361 pipe's reader is the parent, but with vfork the parent can't
1362 run until the child exits. Truncate the diagnostic instead. */
1363 fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
1364
1365 errno = exec_errno;
1366 emacs_perror (new_argv[0]);
1367 _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
1368
1369 #else /* MSDOS */
1370 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1371 xfree (pwd_var);
1372 if (pid == -1)
1373 /* An error occurred while trying to run the subprocess. */
1374 report_file_error ("Spawning child process", Qnil);
1375 return pid;
1376 #endif /* MSDOS */
1377 #endif /* not WINDOWSNT */
1378 }
1379
1380 #ifndef WINDOWSNT
1381 /* Move the file descriptor FD so that its number is not less than MINFD.
1382 If the file descriptor is moved at all, the original is closed on MSDOS,
1383 but not elsewhere as the caller will close it anyway. */
1384 static int
1385 relocate_fd (int fd, int minfd)
1386 {
1387 if (fd >= minfd)
1388 return fd;
1389 else
1390 {
1391 int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd);
1392 if (new == -1)
1393 {
1394 emacs_perror ("while setting up child");
1395 _exit (EXIT_CANCELED);
1396 }
1397 #ifdef MSDOS
1398 emacs_close (fd);
1399 #endif
1400 return new;
1401 }
1402 }
1403 #endif /* not WINDOWSNT */
1404
1405 static bool
1406 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
1407 ptrdiff_t *valuelen, Lisp_Object env)
1408 {
1409 for (; CONSP (env); env = XCDR (env))
1410 {
1411 Lisp_Object entry = XCAR (env);
1412 if (STRINGP (entry)
1413 && SBYTES (entry) >= varlen
1414 #ifdef WINDOWSNT
1415 /* NT environment variables are case insensitive. */
1416 && ! strnicmp (SDATA (entry), var, varlen)
1417 #else /* not WINDOWSNT */
1418 && ! memcmp (SDATA (entry), var, varlen)
1419 #endif /* not WINDOWSNT */
1420 )
1421 {
1422 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1423 {
1424 *value = SSDATA (entry) + (varlen + 1);
1425 *valuelen = SBYTES (entry) - (varlen + 1);
1426 return 1;
1427 }
1428 else if (SBYTES (entry) == varlen)
1429 {
1430 /* Lone variable names in Vprocess_environment mean that
1431 variable should be removed from the environment. */
1432 *value = NULL;
1433 return 1;
1434 }
1435 }
1436 }
1437 return 0;
1438 }
1439
1440 static bool
1441 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
1442 ptrdiff_t *valuelen, Lisp_Object frame)
1443 {
1444 /* Try to find VAR in Vprocess_environment first. */
1445 if (getenv_internal_1 (var, varlen, value, valuelen,
1446 Vprocess_environment))
1447 return *value ? 1 : 0;
1448
1449 /* For DISPLAY try to get the values from the frame or the initial env. */
1450 if (strcmp (var, "DISPLAY") == 0)
1451 {
1452 Lisp_Object display
1453 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1454 if (STRINGP (display))
1455 {
1456 *value = SSDATA (display);
1457 *valuelen = SBYTES (display);
1458 return 1;
1459 }
1460 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1461 if (getenv_internal_1 (var, varlen, value, valuelen,
1462 Vinitial_environment))
1463 return *value ? 1 : 0;
1464 }
1465
1466 return 0;
1467 }
1468
1469 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1470 doc: /* Get the value of environment variable VARIABLE.
1471 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1472 the environment. Otherwise, value is a string.
1473
1474 This function searches `process-environment' for VARIABLE.
1475
1476 If optional parameter ENV is a list, then search this list instead of
1477 `process-environment', and return t when encountering a negative entry
1478 \(an entry for a variable with no value). */)
1479 (Lisp_Object variable, Lisp_Object env)
1480 {
1481 char *value;
1482 ptrdiff_t valuelen;
1483
1484 CHECK_STRING (variable);
1485 if (CONSP (env))
1486 {
1487 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1488 &value, &valuelen, env))
1489 return value ? make_string (value, valuelen) : Qt;
1490 else
1491 return Qnil;
1492 }
1493 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1494 &value, &valuelen, env))
1495 return make_string (value, valuelen);
1496 else
1497 return Qnil;
1498 }
1499
1500 /* A version of getenv that consults the Lisp environment lists,
1501 easily callable from C. */
1502 char *
1503 egetenv (const char *var)
1504 {
1505 char *value;
1506 ptrdiff_t valuelen;
1507
1508 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
1509 return value;
1510 else
1511 return 0;
1512 }
1513
1514 \f
1515 /* This is run before init_cmdargs. */
1516
1517 void
1518 init_callproc_1 (void)
1519 {
1520 #ifdef HAVE_NS
1521 const char *etc_dir = ns_etc_directory ();
1522 const char *path_exec = ns_exec_path ();
1523 #endif
1524
1525 Vdata_directory = decode_env_path ("EMACSDATA",
1526 #ifdef HAVE_NS
1527 etc_dir ? etc_dir :
1528 #endif
1529 PATH_DATA, 0);
1530 Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
1531
1532 Vdoc_directory = decode_env_path ("EMACSDOC",
1533 #ifdef HAVE_NS
1534 etc_dir ? etc_dir :
1535 #endif
1536 PATH_DOC, 0);
1537 Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
1538
1539 /* Check the EMACSPATH environment variable, defaulting to the
1540 PATH_EXEC path from epaths.h. */
1541 Vexec_path = decode_env_path ("EMACSPATH",
1542 #ifdef HAVE_NS
1543 path_exec ? path_exec :
1544 #endif
1545 PATH_EXEC, 0);
1546 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1547 /* FIXME? For ns, path_exec should go at the front? */
1548 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1549 }
1550
1551 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1552
1553 void
1554 init_callproc (void)
1555 {
1556 char *data_dir = egetenv ("EMACSDATA");
1557
1558 register char * sh;
1559 Lisp_Object tempdir;
1560 #ifdef HAVE_NS
1561 if (data_dir == 0)
1562 {
1563 const char *etc_dir = ns_etc_directory ();
1564 if (etc_dir)
1565 {
1566 data_dir = alloca (strlen (etc_dir) + 1);
1567 strcpy (data_dir, etc_dir);
1568 }
1569 }
1570 #endif
1571
1572 if (!NILP (Vinstallation_directory))
1573 {
1574 /* Add to the path the lib-src subdir of the installation dir. */
1575 Lisp_Object tem;
1576 tem = Fexpand_file_name (build_string ("lib-src"),
1577 Vinstallation_directory);
1578 #ifndef MSDOS
1579 /* MSDOS uses wrapped binaries, so don't do this. */
1580 if (NILP (Fmember (tem, Vexec_path)))
1581 {
1582 #ifdef HAVE_NS
1583 const char *path_exec = ns_exec_path ();
1584 #endif
1585 Vexec_path = decode_env_path ("EMACSPATH",
1586 #ifdef HAVE_NS
1587 path_exec ? path_exec :
1588 #endif
1589 PATH_EXEC, 0);
1590 Vexec_path = Fcons (tem, Vexec_path);
1591 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1592 }
1593
1594 Vexec_directory = Ffile_name_as_directory (tem);
1595 #endif /* not MSDOS */
1596
1597 /* Maybe use ../etc as well as ../lib-src. */
1598 if (data_dir == 0)
1599 {
1600 tem = Fexpand_file_name (build_string ("etc"),
1601 Vinstallation_directory);
1602 Vdoc_directory = Ffile_name_as_directory (tem);
1603 }
1604 }
1605
1606 /* Look for the files that should be in etc. We don't use
1607 Vinstallation_directory, because these files are never installed
1608 near the executable, and they are never in the build
1609 directory when that's different from the source directory.
1610
1611 Instead, if these files are not in the nominal place, we try the
1612 source directory. */
1613 if (data_dir == 0)
1614 {
1615 Lisp_Object tem, tem1, srcdir;
1616 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
1617
1618 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
1619
1620 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1621 tem1 = Ffile_exists_p (tem);
1622 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1623 {
1624 Lisp_Object newdir;
1625 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
1626 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1627 tem1 = Ffile_exists_p (tem);
1628 if (!NILP (tem1))
1629 Vdata_directory = newdir;
1630 }
1631 }
1632
1633 #ifndef CANNOT_DUMP
1634 if (initialized)
1635 #endif
1636 {
1637 tempdir = Fdirectory_file_name (Vexec_directory);
1638 if (! file_accessible_directory_p (SSDATA (tempdir)))
1639 dir_warning ("arch-dependent data dir", Vexec_directory);
1640 }
1641
1642 tempdir = Fdirectory_file_name (Vdata_directory);
1643 if (! file_accessible_directory_p (SSDATA (tempdir)))
1644 dir_warning ("arch-independent data dir", Vdata_directory);
1645
1646 sh = getenv ("SHELL");
1647 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1648
1649 #ifdef DOS_NT
1650 Vshared_game_score_directory = Qnil;
1651 #else
1652 Vshared_game_score_directory = build_unibyte_string (PATH_GAME);
1653 if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory)))
1654 Vshared_game_score_directory = Qnil;
1655 #endif
1656 }
1657
1658 void
1659 set_initial_environment (void)
1660 {
1661 char **envp;
1662 for (envp = environ; *envp; envp++)
1663 Vprocess_environment = Fcons (build_string (*envp),
1664 Vprocess_environment);
1665 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1666 to use `delete' and friends on process-environment. */
1667 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1668 }
1669
1670 void
1671 syms_of_callproc (void)
1672 {
1673 #ifndef DOS_NT
1674 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1675 #elif defined (WINDOWSNT)
1676 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1677 #else
1678 Vtemp_file_name_pattern = build_string ("detmp.XXX");
1679 #endif
1680 staticpro (&Vtemp_file_name_pattern);
1681
1682 #ifdef MSDOS
1683 synch_process_tempfile = make_number (0);
1684 staticpro (&synch_process_tempfile);
1685 #endif
1686
1687 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1688 doc: /* File name to load inferior shells from.
1689 Initialized from the SHELL environment variable, or to a system-dependent
1690 default if SHELL is not set. */);
1691
1692 DEFVAR_LISP ("exec-path", Vexec_path,
1693 doc: /* List of directories to search programs to run in subprocesses.
1694 Each element is a string (directory name) or nil (try default directory).
1695
1696 By default the last element of this list is `exec-directory'. The
1697 last element is not always used, for example in shell completion
1698 (`shell-dynamic-complete-command'). */);
1699
1700 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1701 doc: /* List of suffixes to try to find executable file names.
1702 Each element is a string. */);
1703 Vexec_suffixes = Qnil;
1704
1705 DEFVAR_LISP ("exec-directory", Vexec_directory,
1706 doc: /* Directory for executables for Emacs to invoke.
1707 More generally, this includes any architecture-dependent files
1708 that are built and installed from the Emacs distribution. */);
1709
1710 DEFVAR_LISP ("data-directory", Vdata_directory,
1711 doc: /* Directory of machine-independent files that come with GNU Emacs.
1712 These are files intended for Emacs to use while it runs. */);
1713
1714 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1715 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1716 This is usually the same as `data-directory'. */);
1717
1718 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1719 doc: /* For internal use by the build procedure only.
1720 This is the name of the directory in which the build procedure installed
1721 Emacs's info files; the default value for `Info-default-directory-list'
1722 includes this. */);
1723 Vconfigure_info_directory = build_string (PATH_INFO);
1724
1725 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1726 doc: /* Directory of score files for games which come with GNU Emacs.
1727 If this variable is nil, then Emacs is unable to use a shared directory. */);
1728 #ifdef DOS_NT
1729 Vshared_game_score_directory = Qnil;
1730 #else
1731 Vshared_game_score_directory = build_string (PATH_GAME);
1732 #endif
1733
1734 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1735 doc: /* List of environment variables inherited from the parent process.
1736 Each element should be a string of the form ENVVARNAME=VALUE.
1737 The elements must normally be decoded (using `locale-coding-system') for use. */);
1738 Vinitial_environment = Qnil;
1739
1740 DEFVAR_LISP ("process-environment", Vprocess_environment,
1741 doc: /* List of overridden environment variables for subprocesses to inherit.
1742 Each element should be a string of the form ENVVARNAME=VALUE.
1743
1744 Entries in this list take precedence to those in the frame-local
1745 environments. Therefore, let-binding `process-environment' is an easy
1746 way to temporarily change the value of an environment variable,
1747 irrespective of where it comes from. To use `process-environment' to
1748 remove an environment variable, include only its name in the list,
1749 without "=VALUE".
1750
1751 This variable is set to nil when Emacs starts.
1752
1753 If multiple entries define the same variable, the first one always
1754 takes precedence.
1755
1756 Non-ASCII characters are encoded according to the initial value of
1757 `locale-coding-system', i.e. the elements must normally be decoded for
1758 use.
1759
1760 See `setenv' and `getenv'. */);
1761 Vprocess_environment = Qnil;
1762
1763 defsubr (&Scall_process);
1764 defsubr (&Sgetenv_internal);
1765 defsubr (&Scall_process_region);
1766 }