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