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