Merge from emacs-24; up to 2014-06-02T11:35:40Z!michael.albinus@gmx.de
[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 (!nread)
809 ;
810 else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
811 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
812 insert_1_both (buf, nread, nread, 0, 1, 0);
813 else
814 { /* We have to decode the input. */
815 Lisp_Object curbuf;
816 ptrdiff_t count1 = SPECPDL_INDEX ();
817
818 XSETBUFFER (curbuf, current_buffer);
819 /* FIXME: Call signal_after_change! */
820 prepare_to_modify_buffer (PT, PT, NULL);
821 /* We cannot allow after-change-functions be run
822 during decoding, because that might modify the
823 buffer, while we rely on process_coding.produced to
824 faithfully reflect inserted text until we
825 TEMP_SET_PT_BOTH below. */
826 specbind (Qinhibit_modification_hooks, Qt);
827 decode_coding_c_string (&process_coding,
828 (unsigned char *) buf, nread, curbuf);
829 unbind_to (count1, Qnil);
830 if (display_on_the_fly
831 && CODING_REQUIRE_DETECTION (&saved_coding)
832 && ! CODING_REQUIRE_DETECTION (&process_coding))
833 {
834 /* We have detected some coding system, but the
835 detection may have been via insufficient data.
836 So give up displaying on the fly. */
837 if (process_coding.produced > 0)
838 del_range_2 (process_coding.dst_pos,
839 process_coding.dst_pos_byte,
840 (process_coding.dst_pos
841 + process_coding.produced_char),
842 (process_coding.dst_pos_byte
843 + process_coding.produced),
844 0);
845 display_on_the_fly = 0;
846 process_coding = saved_coding;
847 carryover = nread;
848 /* Make the above condition always fail in the future. */
849 saved_coding.common_flags
850 &= ~CODING_REQUIRE_DETECTION_MASK;
851 continue;
852 }
853
854 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
855 PT_BYTE + process_coding.produced);
856 carryover = process_coding.carryover_bytes;
857 if (carryover > 0)
858 memcpy (buf, process_coding.carryover,
859 process_coding.carryover_bytes);
860 }
861
862 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
863 break;
864
865 /* Make the buffer bigger as we continue to read more data,
866 but not past CALLPROC_BUFFER_SIZE_MAX. */
867 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
868 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
869 bufsize = CALLPROC_BUFFER_SIZE_MAX;
870
871 if (display_p)
872 {
873 redisplay_preserve_echo_area (1);
874 /* This variable might have been set to 0 for code
875 detection. In that case, set it back to 1 because
876 we should have already detected a coding system. */
877 display_on_the_fly = 1;
878 }
879 immediate_quit = 1;
880 QUIT;
881 }
882 give_up: ;
883
884 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
885 /* If the caller required, let the buffer inherit the
886 coding-system used to decode the process output. */
887 if (inherit_process_coding_system)
888 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
889 make_number (total_read));
890 }
891
892 #ifndef MSDOS
893 /* Wait for it to terminate, unless it already has. */
894 wait_for_termination (pid, &status, fd0 < 0);
895 #endif
896
897 immediate_quit = 0;
898
899 /* Don't kill any children that the subprocess may have left behind
900 when exiting. */
901 synch_process_pid = 0;
902
903 SAFE_FREE ();
904 unbind_to (count, Qnil);
905
906 if (WIFSIGNALED (status))
907 {
908 const char *signame;
909
910 synchronize_system_messages_locale ();
911 signame = strsignal (WTERMSIG (status));
912
913 if (signame == 0)
914 signame = "unknown";
915
916 return code_convert_string_norecord (build_string (signame),
917 Vlocale_coding_system, 0);
918 }
919
920 eassert (WIFEXITED (status));
921 return make_number (WEXITSTATUS (status));
922 }
923 \f
924 /* Create a temporary file suitable for storing the input data of
925 call-process-region. NARGS and ARGS are the same as for
926 call-process-region. Store into *FILENAME_STRING_PTR a Lisp string
927 naming the file, and return a file descriptor for reading.
928 Unwind-protect the file, so that the file descriptor will be closed
929 and the file removed when the caller unwinds the specpdl stack. */
930
931 static int
932 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
933 Lisp_Object *filename_string_ptr)
934 {
935 int fd;
936 struct gcpro gcpro1;
937 Lisp_Object filename_string;
938 Lisp_Object val, start, end;
939 Lisp_Object tmpdir;
940
941 if (STRINGP (Vtemporary_file_directory))
942 tmpdir = Vtemporary_file_directory;
943 else
944 {
945 char *outf;
946 #ifndef DOS_NT
947 outf = getenv ("TMPDIR");
948 tmpdir = build_string (outf ? outf : "/tmp/");
949 #else /* DOS_NT */
950 if ((outf = egetenv ("TMPDIR"))
951 || (outf = egetenv ("TMP"))
952 || (outf = egetenv ("TEMP")))
953 tmpdir = build_string (outf);
954 else
955 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
956 #endif
957 }
958
959 {
960 Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
961 char *tempfile;
962 ptrdiff_t count;
963
964 #ifdef WINDOWSNT
965 /* Cannot use the result of Fexpand_file_name, because it
966 downcases the XXXXXX part of the pattern, and mktemp then
967 doesn't recognize it. */
968 if (!NILP (Vw32_downcase_file_names))
969 {
970 Lisp_Object dirname = Ffile_name_directory (pattern);
971
972 if (NILP (dirname))
973 pattern = Vtemp_file_name_pattern;
974 else
975 pattern = concat2 (dirname, Vtemp_file_name_pattern);
976 }
977 #endif
978
979 filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
980 GCPRO1 (filename_string);
981 tempfile = SSDATA (filename_string);
982
983 count = SPECPDL_INDEX ();
984 record_unwind_protect_nothing ();
985 fd = mkostemp (tempfile, O_CLOEXEC);
986 if (fd < 0)
987 report_file_error ("Failed to open temporary file using pattern",
988 pattern);
989 set_unwind_protect (count, delete_temp_file, filename_string);
990 record_unwind_protect_int (close_file_unwind, fd);
991 }
992
993 start = args[0];
994 end = args[1];
995 /* Decide coding-system of the contents of the temporary file. */
996 if (!NILP (Vcoding_system_for_write))
997 val = Vcoding_system_for_write;
998 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
999 val = Qraw_text;
1000 else
1001 {
1002 Lisp_Object coding_systems;
1003 Lisp_Object *args2;
1004 USE_SAFE_ALLOCA;
1005 SAFE_NALLOCA (args2, 1, nargs + 1);
1006 args2[0] = Qcall_process_region;
1007 memcpy (args2 + 1, args, nargs * sizeof *args);
1008 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1009 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
1010 SAFE_FREE ();
1011 }
1012 val = complement_process_encoding_system (val);
1013
1014 {
1015 ptrdiff_t count1 = SPECPDL_INDEX ();
1016
1017 specbind (intern ("coding-system-for-write"), val);
1018 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1019 happen to get a ".Z" suffix. */
1020 specbind (intern ("file-name-handler-alist"), Qnil);
1021 write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
1022
1023 unbind_to (count1, Qnil);
1024 }
1025
1026 if (lseek (fd, 0, SEEK_SET) < 0)
1027 report_file_error ("Setting file position", filename_string);
1028
1029 /* Note that Fcall_process takes care of binding
1030 coding-system-for-read. */
1031
1032 *filename_string_ptr = filename_string;
1033 UNGCPRO;
1034 return fd;
1035 }
1036
1037 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
1038 3, MANY, 0,
1039 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1040 The remaining arguments are optional.
1041 Delete the text if fourth arg DELETE is non-nil.
1042
1043 Insert output in BUFFER before point; t means current buffer; nil for
1044 BUFFER means discard it; 0 means discard and don't wait; and `(:file
1045 FILE)', where FILE is a file name string, means that it should be
1046 written to that file (if the file already exists it is overwritten).
1047 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1048 REAL-BUFFER says what to do with standard output, as above,
1049 while STDERR-FILE says what to do with standard error in the child.
1050 STDERR-FILE may be nil (discard standard error output),
1051 t (mix it with ordinary output), or a file name string.
1052
1053 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1054 Remaining args are passed to PROGRAM at startup as command args.
1055
1056 If BUFFER is 0, `call-process-region' returns immediately with value nil.
1057 Otherwise it waits for PROGRAM to terminate
1058 and returns a numeric exit status or a signal description string.
1059 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1060
1061 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
1062 (ptrdiff_t nargs, Lisp_Object *args)
1063 {
1064 struct gcpro gcpro1;
1065 Lisp_Object infile, val;
1066 ptrdiff_t count = SPECPDL_INDEX ();
1067 Lisp_Object start = args[0];
1068 Lisp_Object end = args[1];
1069 bool empty_input;
1070 int fd;
1071
1072 if (STRINGP (start))
1073 empty_input = SCHARS (start) == 0;
1074 else if (NILP (start))
1075 empty_input = BEG == Z;
1076 else
1077 {
1078 validate_region (&args[0], &args[1]);
1079 start = args[0];
1080 end = args[1];
1081 empty_input = XINT (start) == XINT (end);
1082 }
1083
1084 if (!empty_input)
1085 fd = create_temp_file (nargs, args, &infile);
1086 else
1087 {
1088 infile = Qnil;
1089 fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
1090 if (fd < 0)
1091 report_file_error ("Opening null device", Qnil);
1092 record_unwind_protect_int (close_file_unwind, fd);
1093 }
1094
1095 GCPRO1 (infile);
1096
1097 if (nargs > 3 && !NILP (args[3]))
1098 Fdelete_region (start, end);
1099
1100 if (nargs > 3)
1101 {
1102 args += 2;
1103 nargs -= 2;
1104 }
1105 else
1106 {
1107 args[0] = args[2];
1108 nargs = 2;
1109 }
1110 args[1] = infile;
1111
1112 val = call_process (nargs, args, fd, empty_input ? -1 : count);
1113 RETURN_UNGCPRO (unbind_to (count, val));
1114 }
1115 \f
1116 #ifndef WINDOWSNT
1117 static int relocate_fd (int fd, int minfd);
1118 #endif
1119
1120 static char **
1121 add_env (char **env, char **new_env, char *string)
1122 {
1123 char **ep;
1124 bool ok = 1;
1125 if (string == NULL)
1126 return new_env;
1127
1128 /* See if this string duplicates any string already in the env.
1129 If so, don't put it in.
1130 When an env var has multiple definitions,
1131 we keep the definition that comes first in process-environment. */
1132 for (ep = env; ok && ep != new_env; ep++)
1133 {
1134 char *p = *ep, *q = string;
1135 while (ok)
1136 {
1137 if (*q != *p)
1138 break;
1139 if (*q == 0)
1140 /* The string is a lone variable name; keep it for now, we
1141 will remove it later. It is a placeholder for a
1142 variable that is not to be included in the environment. */
1143 break;
1144 if (*q == '=')
1145 ok = 0;
1146 p++, q++;
1147 }
1148 }
1149 if (ok)
1150 *new_env++ = string;
1151 return new_env;
1152 }
1153
1154 /* This is the last thing run in a newly forked inferior
1155 either synchronous or asynchronous.
1156 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1157 Initialize inferior's priority, pgrp, connected dir and environment.
1158 then exec another program based on new_argv.
1159
1160 If SET_PGRP, put the subprocess into a separate process group.
1161
1162 CURRENT_DIR is an elisp string giving the path of the current
1163 directory the subprocess should have. Since we can't really signal
1164 a decent error from within the child, this should be verified as an
1165 executable directory by the parent. */
1166
1167 int
1168 child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
1169 Lisp_Object current_dir)
1170 {
1171 char **env;
1172 char *pwd_var;
1173 #ifdef WINDOWSNT
1174 int cpid;
1175 HANDLE handles[3];
1176 #else
1177 int exec_errno;
1178
1179 pid_t pid = getpid ();
1180 #endif /* WINDOWSNT */
1181
1182 /* Note that use of alloca is always safe here. It's obvious for systems
1183 that do not have true vfork or that have true (stack) alloca.
1184 If using vfork and C_ALLOCA (when Emacs used to include
1185 src/alloca.c) it is safe because that changes the superior's
1186 static variables as if the superior had done alloca and will be
1187 cleaned up in the usual way. */
1188 {
1189 char *temp;
1190 ptrdiff_t i;
1191
1192 i = SBYTES (current_dir);
1193 #ifdef MSDOS
1194 /* MSDOS must have all environment variables malloc'ed, because
1195 low-level libc functions that launch subsidiary processes rely
1196 on that. */
1197 pwd_var = xmalloc (i + 5);
1198 #else
1199 pwd_var = alloca (i + 5);
1200 #endif
1201 temp = pwd_var + 4;
1202 memcpy (pwd_var, "PWD=", 4);
1203 strcpy (temp, SSDATA (current_dir));
1204
1205 #ifndef DOS_NT
1206 /* We can't signal an Elisp error here; we're in a vfork. Since
1207 the callers check the current directory before forking, this
1208 should only return an error if the directory's permissions
1209 are changed between the check and this chdir, but we should
1210 at least check. */
1211 if (chdir (temp) < 0)
1212 _exit (EXIT_CANCELED);
1213 #else /* DOS_NT */
1214 /* Get past the drive letter, so that d:/ is left alone. */
1215 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1216 {
1217 temp += 2;
1218 i -= 2;
1219 }
1220 #endif /* DOS_NT */
1221
1222 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1223 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1224 temp[--i] = 0;
1225 }
1226
1227 /* Set `env' to a vector of the strings in the environment. */
1228 {
1229 register Lisp_Object tem;
1230 register char **new_env;
1231 char **p, **q;
1232 register int new_length;
1233 Lisp_Object display = Qnil;
1234
1235 new_length = 0;
1236
1237 for (tem = Vprocess_environment;
1238 CONSP (tem) && STRINGP (XCAR (tem));
1239 tem = XCDR (tem))
1240 {
1241 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1242 && (SDATA (XCAR (tem)) [7] == '\0'
1243 || SDATA (XCAR (tem)) [7] == '='))
1244 /* DISPLAY is specified in process-environment. */
1245 display = Qt;
1246 new_length++;
1247 }
1248
1249 /* If not provided yet, use the frame's DISPLAY. */
1250 if (NILP (display))
1251 {
1252 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1253 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1254 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1255 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1256 Vinitial_environment);
1257 if (STRINGP (tmp))
1258 {
1259 display = tmp;
1260 new_length++;
1261 }
1262 }
1263
1264 /* new_length + 2 to include PWD and terminating 0. */
1265 env = new_env = alloca ((new_length + 2) * sizeof *env);
1266 /* If we have a PWD envvar, pass one down,
1267 but with corrected value. */
1268 if (egetenv ("PWD"))
1269 *new_env++ = pwd_var;
1270
1271 if (STRINGP (display))
1272 {
1273 char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
1274 strcpy (vdata, "DISPLAY=");
1275 strcat (vdata, SSDATA (display));
1276 new_env = add_env (env, new_env, vdata);
1277 }
1278
1279 /* Overrides. */
1280 for (tem = Vprocess_environment;
1281 CONSP (tem) && STRINGP (XCAR (tem));
1282 tem = XCDR (tem))
1283 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1284
1285 *new_env = 0;
1286
1287 /* Remove variable names without values. */
1288 p = q = env;
1289 while (*p != 0)
1290 {
1291 while (*q != 0 && strchr (*q, '=') == NULL)
1292 q++;
1293 *p = *q++;
1294 if (*p != 0)
1295 p++;
1296 }
1297 }
1298
1299
1300 #ifdef WINDOWSNT
1301 prepare_standard_handles (in, out, err, handles);
1302 set_process_dir (SDATA (current_dir));
1303 /* Spawn the child. (See w32proc.c:sys_spawnve). */
1304 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1305 reset_standard_handles (in, out, err, handles);
1306 if (cpid == -1)
1307 /* An error occurred while trying to spawn the process. */
1308 report_file_error ("Spawning child process", Qnil);
1309 return cpid;
1310
1311 #else /* not WINDOWSNT */
1312 /* Make sure that in, out, and err are not actually already in
1313 descriptors zero, one, or two; this could happen if Emacs is
1314 started with its standard in, out, or error closed, as might
1315 happen under X. */
1316 {
1317 int oin = in, oout = out;
1318
1319 /* We have to avoid relocating the same descriptor twice! */
1320
1321 in = relocate_fd (in, 3);
1322
1323 if (out == oin)
1324 out = in;
1325 else
1326 out = relocate_fd (out, 3);
1327
1328 if (err == oin)
1329 err = in;
1330 else if (err == oout)
1331 err = out;
1332 else
1333 err = relocate_fd (err, 3);
1334 }
1335
1336 #ifndef MSDOS
1337 /* Redirect file descriptors and clear the close-on-exec flag on the
1338 redirected ones. IN, OUT, and ERR are close-on-exec so they
1339 need not be closed explicitly. */
1340 dup2 (in, 0);
1341 dup2 (out, 1);
1342 dup2 (err, 2);
1343
1344 setpgid (0, 0);
1345 tcsetpgrp (0, pid);
1346
1347 execve (new_argv[0], new_argv, env);
1348 exec_errno = errno;
1349
1350 /* Avoid deadlock if the child's perror writes to a full pipe; the
1351 pipe's reader is the parent, but with vfork the parent can't
1352 run until the child exits. Truncate the diagnostic instead. */
1353 fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
1354
1355 errno = exec_errno;
1356 emacs_perror (new_argv[0]);
1357 _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
1358
1359 #else /* MSDOS */
1360 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1361 xfree (pwd_var);
1362 if (pid == -1)
1363 /* An error occurred while trying to run the subprocess. */
1364 report_file_error ("Spawning child process", Qnil);
1365 return pid;
1366 #endif /* MSDOS */
1367 #endif /* not WINDOWSNT */
1368 }
1369
1370 #ifndef WINDOWSNT
1371 /* Move the file descriptor FD so that its number is not less than MINFD.
1372 If the file descriptor is moved at all, the original is closed on MSDOS,
1373 but not elsewhere as the caller will close it anyway. */
1374 static int
1375 relocate_fd (int fd, int minfd)
1376 {
1377 if (fd >= minfd)
1378 return fd;
1379 else
1380 {
1381 int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd);
1382 if (new == -1)
1383 {
1384 emacs_perror ("while setting up child");
1385 _exit (EXIT_CANCELED);
1386 }
1387 #ifdef MSDOS
1388 emacs_close (fd);
1389 #endif
1390 return new;
1391 }
1392 }
1393 #endif /* not WINDOWSNT */
1394
1395 static bool
1396 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
1397 ptrdiff_t *valuelen, Lisp_Object env)
1398 {
1399 for (; CONSP (env); env = XCDR (env))
1400 {
1401 Lisp_Object entry = XCAR (env);
1402 if (STRINGP (entry)
1403 && SBYTES (entry) >= varlen
1404 #ifdef WINDOWSNT
1405 /* NT environment variables are case insensitive. */
1406 && ! strnicmp (SDATA (entry), var, varlen)
1407 #else /* not WINDOWSNT */
1408 && ! memcmp (SDATA (entry), var, varlen)
1409 #endif /* not WINDOWSNT */
1410 )
1411 {
1412 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1413 {
1414 *value = SSDATA (entry) + (varlen + 1);
1415 *valuelen = SBYTES (entry) - (varlen + 1);
1416 return 1;
1417 }
1418 else if (SBYTES (entry) == varlen)
1419 {
1420 /* Lone variable names in Vprocess_environment mean that
1421 variable should be removed from the environment. */
1422 *value = NULL;
1423 return 1;
1424 }
1425 }
1426 }
1427 return 0;
1428 }
1429
1430 static bool
1431 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
1432 ptrdiff_t *valuelen, Lisp_Object frame)
1433 {
1434 /* Try to find VAR in Vprocess_environment first. */
1435 if (getenv_internal_1 (var, varlen, value, valuelen,
1436 Vprocess_environment))
1437 return *value ? 1 : 0;
1438
1439 /* For DISPLAY try to get the values from the frame or the initial env. */
1440 if (strcmp (var, "DISPLAY") == 0)
1441 {
1442 Lisp_Object display
1443 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1444 if (STRINGP (display))
1445 {
1446 *value = SSDATA (display);
1447 *valuelen = SBYTES (display);
1448 return 1;
1449 }
1450 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1451 if (getenv_internal_1 (var, varlen, value, valuelen,
1452 Vinitial_environment))
1453 return *value ? 1 : 0;
1454 }
1455
1456 return 0;
1457 }
1458
1459 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1460 doc: /* Get the value of environment variable VARIABLE.
1461 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1462 the environment. Otherwise, value is a string.
1463
1464 This function searches `process-environment' for VARIABLE.
1465
1466 If optional parameter ENV is a list, then search this list instead of
1467 `process-environment', and return t when encountering a negative entry
1468 \(an entry for a variable with no value). */)
1469 (Lisp_Object variable, Lisp_Object env)
1470 {
1471 char *value;
1472 ptrdiff_t valuelen;
1473
1474 CHECK_STRING (variable);
1475 if (CONSP (env))
1476 {
1477 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1478 &value, &valuelen, env))
1479 return value ? make_string (value, valuelen) : Qt;
1480 else
1481 return Qnil;
1482 }
1483 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1484 &value, &valuelen, env))
1485 return make_string (value, valuelen);
1486 else
1487 return Qnil;
1488 }
1489
1490 /* A version of getenv that consults the Lisp environment lists,
1491 easily callable from C. */
1492 char *
1493 egetenv (const char *var)
1494 {
1495 char *value;
1496 ptrdiff_t valuelen;
1497
1498 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
1499 return value;
1500 else
1501 return 0;
1502 }
1503
1504 \f
1505 /* This is run before init_cmdargs. */
1506
1507 void
1508 init_callproc_1 (void)
1509 {
1510 #ifdef HAVE_NS
1511 const char *etc_dir = ns_etc_directory ();
1512 const char *path_exec = ns_exec_path ();
1513 #endif
1514
1515 Vdata_directory = decode_env_path ("EMACSDATA",
1516 #ifdef HAVE_NS
1517 etc_dir ? etc_dir :
1518 #endif
1519 PATH_DATA, 0);
1520 Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
1521
1522 Vdoc_directory = decode_env_path ("EMACSDOC",
1523 #ifdef HAVE_NS
1524 etc_dir ? etc_dir :
1525 #endif
1526 PATH_DOC, 0);
1527 Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
1528
1529 /* Check the EMACSPATH environment variable, defaulting to the
1530 PATH_EXEC path from epaths.h. */
1531 Vexec_path = decode_env_path ("EMACSPATH",
1532 #ifdef HAVE_NS
1533 path_exec ? path_exec :
1534 #endif
1535 PATH_EXEC, 0);
1536 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1537 /* FIXME? For ns, path_exec should go at the front? */
1538 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1539 }
1540
1541 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1542
1543 void
1544 init_callproc (void)
1545 {
1546 char *data_dir = egetenv ("EMACSDATA");
1547
1548 register char * sh;
1549 Lisp_Object tempdir;
1550 #ifdef HAVE_NS
1551 if (data_dir == 0)
1552 {
1553 const char *etc_dir = ns_etc_directory ();
1554 if (etc_dir)
1555 {
1556 data_dir = alloca (strlen (etc_dir) + 1);
1557 strcpy (data_dir, etc_dir);
1558 }
1559 }
1560 #endif
1561
1562 if (!NILP (Vinstallation_directory))
1563 {
1564 /* Add to the path the lib-src subdir of the installation dir. */
1565 Lisp_Object tem;
1566 tem = Fexpand_file_name (build_string ("lib-src"),
1567 Vinstallation_directory);
1568 #ifndef MSDOS
1569 /* MSDOS uses wrapped binaries, so don't do this. */
1570 if (NILP (Fmember (tem, Vexec_path)))
1571 {
1572 #ifdef HAVE_NS
1573 const char *path_exec = ns_exec_path ();
1574 #endif
1575 Vexec_path = decode_env_path ("EMACSPATH",
1576 #ifdef HAVE_NS
1577 path_exec ? path_exec :
1578 #endif
1579 PATH_EXEC, 0);
1580 Vexec_path = Fcons (tem, Vexec_path);
1581 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1582 }
1583
1584 Vexec_directory = Ffile_name_as_directory (tem);
1585 #endif /* not MSDOS */
1586
1587 /* Maybe use ../etc as well as ../lib-src. */
1588 if (data_dir == 0)
1589 {
1590 tem = Fexpand_file_name (build_string ("etc"),
1591 Vinstallation_directory);
1592 Vdoc_directory = Ffile_name_as_directory (tem);
1593 }
1594 }
1595
1596 /* Look for the files that should be in etc. We don't use
1597 Vinstallation_directory, because these files are never installed
1598 near the executable, and they are never in the build
1599 directory when that's different from the source directory.
1600
1601 Instead, if these files are not in the nominal place, we try the
1602 source directory. */
1603 if (data_dir == 0)
1604 {
1605 Lisp_Object tem, tem1, srcdir;
1606 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
1607
1608 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
1609
1610 tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
1611 tem1 = Ffile_exists_p (tem);
1612 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1613 {
1614 Lisp_Object newdir;
1615 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
1616 tem = Fexpand_file_name (build_string ("NEWS"), newdir);
1617 tem1 = Ffile_exists_p (tem);
1618 if (!NILP (tem1))
1619 Vdata_directory = newdir;
1620 }
1621 }
1622
1623 #ifndef CANNOT_DUMP
1624 if (initialized)
1625 #endif
1626 {
1627 tempdir = Fdirectory_file_name (Vexec_directory);
1628 if (! file_accessible_directory_p (SSDATA (tempdir)))
1629 dir_warning ("arch-dependent data dir", Vexec_directory);
1630 }
1631
1632 tempdir = Fdirectory_file_name (Vdata_directory);
1633 if (! file_accessible_directory_p (SSDATA (tempdir)))
1634 dir_warning ("arch-independent data dir", Vdata_directory);
1635
1636 sh = getenv ("SHELL");
1637 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1638
1639 #ifdef DOS_NT
1640 Vshared_game_score_directory = Qnil;
1641 #else
1642 Vshared_game_score_directory = build_unibyte_string (PATH_GAME);
1643 if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory)))
1644 Vshared_game_score_directory = Qnil;
1645 #endif
1646 }
1647
1648 void
1649 set_initial_environment (void)
1650 {
1651 char **envp;
1652 for (envp = environ; *envp; envp++)
1653 Vprocess_environment = Fcons (build_string (*envp),
1654 Vprocess_environment);
1655 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1656 to use `delete' and friends on process-environment. */
1657 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1658 }
1659
1660 void
1661 syms_of_callproc (void)
1662 {
1663 #ifndef DOS_NT
1664 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1665 #else /* DOS_NT */
1666 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1667 #endif
1668 staticpro (&Vtemp_file_name_pattern);
1669
1670 #ifdef MSDOS
1671 synch_process_tempfile = make_number (0);
1672 staticpro (&synch_process_tempfile);
1673 #endif
1674
1675 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1676 doc: /* File name to load inferior shells from.
1677 Initialized from the SHELL environment variable, or to a system-dependent
1678 default if SHELL is not set. */);
1679
1680 DEFVAR_LISP ("exec-path", Vexec_path,
1681 doc: /* List of directories to search programs to run in subprocesses.
1682 Each element is a string (directory name) or nil (try default directory).
1683
1684 By default the last element of this list is `exec-directory'. The
1685 last element is not always used, for example in shell completion
1686 (`shell-dynamic-complete-command'). */);
1687
1688 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1689 doc: /* List of suffixes to try to find executable file names.
1690 Each element is a string. */);
1691 Vexec_suffixes = Qnil;
1692
1693 DEFVAR_LISP ("exec-directory", Vexec_directory,
1694 doc: /* Directory for executables for Emacs to invoke.
1695 More generally, this includes any architecture-dependent files
1696 that are built and installed from the Emacs distribution. */);
1697
1698 DEFVAR_LISP ("data-directory", Vdata_directory,
1699 doc: /* Directory of machine-independent files that come with GNU Emacs.
1700 These are files intended for Emacs to use while it runs. */);
1701
1702 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1703 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1704 This is usually the same as `data-directory'. */);
1705
1706 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1707 doc: /* For internal use by the build procedure only.
1708 This is the name of the directory in which the build procedure installed
1709 Emacs's info files; the default value for `Info-default-directory-list'
1710 includes this. */);
1711 Vconfigure_info_directory = build_string (PATH_INFO);
1712
1713 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1714 doc: /* Directory of score files for games which come with GNU Emacs.
1715 If this variable is nil, then Emacs is unable to use a shared directory. */);
1716 #ifdef DOS_NT
1717 Vshared_game_score_directory = Qnil;
1718 #else
1719 Vshared_game_score_directory = build_string (PATH_GAME);
1720 #endif
1721
1722 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1723 doc: /* List of environment variables inherited from the parent process.
1724 Each element should be a string of the form ENVVARNAME=VALUE.
1725 The elements must normally be decoded (using `locale-coding-system') for use. */);
1726 Vinitial_environment = Qnil;
1727
1728 DEFVAR_LISP ("process-environment", Vprocess_environment,
1729 doc: /* List of overridden environment variables for subprocesses to inherit.
1730 Each element should be a string of the form ENVVARNAME=VALUE.
1731
1732 Entries in this list take precedence to those in the frame-local
1733 environments. Therefore, let-binding `process-environment' is an easy
1734 way to temporarily change the value of an environment variable,
1735 irrespective of where it comes from. To use `process-environment' to
1736 remove an environment variable, include only its name in the list,
1737 without "=VALUE".
1738
1739 This variable is set to nil when Emacs starts.
1740
1741 If multiple entries define the same variable, the first one always
1742 takes precedence.
1743
1744 Non-ASCII characters are encoded according to the initial value of
1745 `locale-coding-system', i.e. the elements must normally be decoded for
1746 use.
1747
1748 See `setenv' and `getenv'. */);
1749 Vprocess_environment = Qnil;
1750
1751 defsubr (&Scall_process);
1752 defsubr (&Sgetenv_internal);
1753 defsubr (&Scall_process_region);
1754 }