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