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