Mercurial > hg > xemacs-beta

comparison src/callproc.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children a5df635868b2
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Synchronous subprocess invocation for XEmacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: Mule 2.0, FSF 19.30. */
22 /* Partly sync'ed with 19.36.4 */
23
24 #include <config.h>
25 #include "lisp.h"
26
27 #include "buffer.h"
28 #include "commands.h"
29 #include "insdel.h"
30 #include "lstream.h"
31 #include "process.h"
32 #include "sysdep.h"
33 #include "window.h"
34 #ifdef FILE_CODING
35 #include "file-coding.h"
36 #endif
37
38 #include "systime.h"
39 #include "sysproc.h"
40 #include "sysfile.h" /* Always include after sysproc.h */
41 #include "syssignal.h" /* Always include before systty.h */
42 #include "systty.h"
43
44 #ifdef WINDOWSNT
45 #define _P_NOWAIT 1 /* from process.h */
46 #include <windows.h>
47 #include "nt.h"
48 #endif
49
50 #ifdef DOS_NT
51 /* When we are starting external processes we need to know whether they
52 take binary input (no conversion) or text input (\n is converted to
53 \r\n). Similarly for output: if newlines are written as \r\n then it's
54 text process output, otherwise it's binary. */
55 Lisp_Object Vbinary_process_input;
56 Lisp_Object Vbinary_process_output;
57 #endif /* DOS_NT */
58
59 Lisp_Object Vshell_file_name;
60
61 /* The environment to pass to all subprocesses when they are started.
62 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
63 */
64 Lisp_Object Vprocess_environment;
65
66 /* True iff we are about to fork off a synchronous process or if we
67 are waiting for it. */
68 volatile int synch_process_alive;
69
70 /* Nonzero => this is a string explaining death of synchronous subprocess. */
71 CONST char *synch_process_death;
72
73 /* If synch_process_death is zero,
74 this is exit code of synchronous subprocess. */
75 int synch_process_retcode;
76
77 /* Clean up when exiting Fcall_process_internal.
78 On MSDOS, delete the temporary file on any kind of termination.
79 On Unix, kill the process and any children on termination by signal. */
80
81 /* Nonzero if this is termination due to exit. */
82 static int call_process_exited;
83
84 Lisp_Object Vlisp_EXEC_SUFFIXES;
85
86 static Lisp_Object
87 call_process_kill (Lisp_Object fdpid)
88 {
89 Lisp_Object fd = Fcar (fdpid);
90 Lisp_Object pid = Fcdr (fdpid);
91
92 if (!NILP (fd))
93 close (XINT (fd));
94
95 if (!NILP (pid))
96 EMACS_KILLPG (XINT (pid), SIGKILL);
97
98 synch_process_alive = 0;
99 return Qnil;
100 }
101
102 static Lisp_Object
103 call_process_cleanup (Lisp_Object fdpid)
104 {
105 int fd = XINT (Fcar (fdpid));
106 int pid = XINT (Fcdr (fdpid));
107
108 if (!call_process_exited &&
109 EMACS_KILLPG (pid, SIGINT) == 0)
110 {
111 int speccount = specpdl_depth ();
112
113 record_unwind_protect (call_process_kill, fdpid);
114 /* #### "c-G" -- need non-consing Single-key-description */
115 message ("Waiting for process to die...(type C-g again to kill it instantly)");
116
117 wait_for_termination (pid);
118
119 /* "Discard" the unwind protect. */
120 XCAR (fdpid) = Qnil;
121 XCDR (fdpid) = Qnil;
122 unbind_to (speccount, Qnil);
123
124 message ("Waiting for process to die... done");
125 }
126 synch_process_alive = 0;
127 close (fd);
128 return Qnil;
129 }
130
131 static Lisp_Object fork_error;
132 #if 0 /* UNUSED */
133 static void
134 report_fork_error (char *string, Lisp_Object data)
135 {
136 Lisp_Object errstring = lisp_strerror (errno);
137
138 fork_error = Fcons (build_string (string), Fcons (errstring, data));
139
140 /* terminate this branch of the fork, without closing stdin/out/etc. */
141 _exit (1);
142 }
143 #endif /* unused */
144
145 DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /*
146 Call PROGRAM synchronously in separate process, with coding-system specified.
147 Arguments are
148 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
149 The program's input comes from file INFILE (nil means `/dev/null').
150 Insert output in BUFFER before point; t means current buffer;
151 nil for BUFFER means discard it; 0 means discard and don't wait.
152 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
153 REAL-BUFFER says what to do with standard output, as above,
154 while STDERR-FILE says what to do with standard error in the child.
155 STDERR-FILE may be nil (discard standard error output),
156 t (mix it with ordinary output), or a file name string.
157
158 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
159 Remaining arguments are strings passed as command arguments to PROGRAM.
160
161 If BUFFER is 0, `call-process' returns immediately with value nil.
162 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
163 or a signal description string.
164 If you quit, the process is killed with SIGINT, or SIGKILL if you
165 quit again.
166 */
167 (int nargs, Lisp_Object *args))
168 {
169 /* This function can GC */
170 Lisp_Object infile, buffer, current_dir, display, path;
171 int fd[2];
172 int filefd;
173 int pid;
174 char buf[16384];
175 char *bufptr = buf;
176 int bufsize = 16384;
177 int speccount = specpdl_depth ();
178 struct gcpro gcpro1, gcpro2;
179 char **new_argv = alloca_array (char *, max (2, nargs - 2));
180
181 /* File to use for stderr in the child.
182 t means use same as standard output. */
183 Lisp_Object error_file;
184
185 CHECK_STRING (args[0]);
186
187 error_file = Qt;
188
189 #if defined (NO_SUBPROCESSES)
190 /* Without asynchronous processes we cannot have BUFFER == 0. */
191 if (nargs >= 3 && !INTP (args[2]))
192 error ("Operating system cannot handle asynchronous subprocesses");
193 #endif /* NO_SUBPROCESSES */
194
195 /* Do this before building new_argv because GC in Lisp code
196 * called by various filename-hacking routines might relocate strings */
197 locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK);
198
199 /* Make sure that the child will be able to chdir to the current
200 buffer's current directory, or its unhandled equivalent. We
201 can't just have the child check for an error when it does the
202 chdir, since it's in a vfork. */
203 {
204 struct gcpro ngcpro1, ngcpro2;
205 /* Do this test before building new_argv because GC in Lisp code
206 * called by various filename-hacking routines might relocate strings */
207 /* Make sure that the child will be able to chdir to the current
208 buffer's current directory. We can't just have the child check
209 for an error when it does the chdir, since it's in a vfork. */
210
211 NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
212 current_dir = current_buffer->directory;
213 current_dir = Funhandled_file_name_directory (current_dir);
214 current_dir = expand_and_dir_to_file (current_dir, Qnil);
215 #if 0
216 /* This is in FSF, but it breaks everything in the presence of
217 ange-ftp-visited files, so away with it. */
218 if (NILP (Ffile_accessible_directory_p (current_dir)))
219 report_file_error ("Setting current directory",
220 Fcons (current_buffer->directory, Qnil));
221 #endif /* 0 */
222 NUNGCPRO;
223 }
224
225 GCPRO1 (current_dir);
226
227 if (nargs >= 2 && ! NILP (args[1]))
228 {
229 struct gcpro ngcpro1;
230 NGCPRO1 (current_buffer->directory);
231 infile = Fexpand_file_name (args[1], current_buffer->directory);
232 NUNGCPRO;
233 CHECK_STRING (infile);
234 }
235 else
236 infile = build_string (NULL_DEVICE);
237
238 UNGCPRO;
239
240 GCPRO2 (infile, current_dir); /* Fexpand_file_name might trash it */
241
242 if (nargs >= 3)
243 {
244 buffer = args[2];
245
246 /* If BUFFER is a list, its meaning is
247 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
248 if (CONSP (buffer))
249 {
250 if (CONSP (XCDR (buffer)))
251 {
252 Lisp_Object file_for_stderr = XCAR (XCDR (buffer));
253
254 if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr))
255 error_file = file_for_stderr;
256 else
257 error_file = Fexpand_file_name (file_for_stderr, Qnil);
258 }
259
260 buffer = XCAR (buffer);
261 }
262
263 if (!(EQ (buffer, Qnil)
264 || EQ (buffer, Qt)
265 || ZEROP (buffer)))
266 {
267 Lisp_Object spec_buffer = buffer;
268 buffer = Fget_buffer (buffer);
269 /* Mention the buffer name for a better error message. */
270 if (NILP (buffer))
271 CHECK_BUFFER (spec_buffer);
272 CHECK_BUFFER (buffer);
273 }
274 }
275 else
276 buffer = Qnil;
277
278 UNGCPRO;
279
280 display = ((nargs >= 4) ? args[3] : Qnil);
281
282 /* From here we assume we won't GC (unless an error is signaled). */
283 {
284 REGISTER int i;
285 for (i = 4; i < nargs; i++)
286 {
287 CHECK_STRING (args[i]);
288 new_argv[i - 3] = (char *) XSTRING_DATA (args[i]);
289 }
290 new_argv[nargs - 3] = 0;
291 }
292
293 if (NILP (path))
294 report_file_error ("Searching for program", Fcons (args[0], Qnil));
295 new_argv[0] = (char *) XSTRING_DATA (path);
296
297 filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY | OPEN_BINARY, 0);
298 if (filefd < 0)
299 report_file_error ("Opening process input file", Fcons (infile, Qnil));
300
301 if (INTP (buffer))
302 {
303 fd[1] = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0);
304 fd[0] = -1;
305 }
306 else
307 {
308 pipe (fd);
309 #if 0
310 /* Replaced by close_process_descs */
311 set_exclusive_use (fd[0]);
312 #endif
313 }
314
315 {
316 /* child_setup must clobber environ in systems with true vfork.
317 Protect it from permanent change. */
318 REGISTER char **save_environ = environ;
319 REGISTER int fd1 = fd[1];
320 int fd_error = fd1;
321 char **env;
322
323 env = environ;
324
325 /* Record that we're about to create a synchronous process. */
326 synch_process_alive = 1;
327
328 /* These vars record information from process termination.
329 Clear them now before process can possibly terminate,
330 to avoid timing error if process terminates soon. */
331 synch_process_death = 0;
332 synch_process_retcode = 0;
333
334 if (NILP (error_file))
335 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
336 else if (STRINGP (error_file))
337 {
338 fd_error = open ((CONST char *) XSTRING_DATA (error_file),
339 #ifdef DOS_NT
340 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
341 S_IREAD | S_IWRITE
342 #else /* not DOS_NT */
343 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
344 CREAT_MODE
345 #endif /* not DOS_NT */
346 );
347 }
348
349 if (fd_error < 0)
350 {
351 close (filefd);
352 close (fd[0]);
353 if (fd1 >= 0)
354 close (fd1);
355 report_file_error ("Cannot open", Fcons(error_file, Qnil));
356 }
357
358 fork_error = Qnil;
359 #ifdef WINDOWSNT
360 pid = child_setup (filefd, fd1, fd_error, new_argv,
361 (char *) XSTRING_DATA (current_dir));
362 #else /* not WINDOWSNT */
363 pid = fork ();
364
365 if (pid == 0)
366 {
367 if (fd[0] >= 0)
368 close (fd[0]);
369 /* This is necessary because some shells may attempt to
370 access the current controlling terminal and will hang
371 if they are run in the background, as will be the case
372 when XEmacs is started in the background. Martin
373 Buchholz observed this problem running a subprocess
374 that used zsh to call gzip to uncompress an info
375 file. */
376 disconnect_controlling_terminal ();
377 child_setup (filefd, fd1, fd_error, new_argv,
378 (char *) XSTRING_DATA (current_dir));
379 }
380 if (fd_error >= 0)
381 close (fd_error);
382
383 #endif /* not WINDOWSNT */
384
385 environ = save_environ;
386
387 /* Close most of our fd's, but not fd[0]
388 since we will use that to read input from. */
389 close (filefd);
390 if (fd1 >= 0)
391 close (fd1);
392 }
393
394 if (!NILP (fork_error))
395 signal_error (Qfile_error, fork_error);
396
397 if (pid < 0)
398 {
399 if (fd[0] >= 0)
400 close (fd[0]);
401 report_file_error ("Doing fork", Qnil);
402 }
403
404 if (INTP (buffer))
405 {
406 if (fd[0] >= 0)
407 close (fd[0]);
408 #if defined (NO_SUBPROCESSES)
409 /* If Emacs has been built with asynchronous subprocess support,
410 we don't need to do this, I think because it will then have
411 the facilities for handling SIGCHLD. */
412 wait_without_blocking ();
413 #endif /* NO_SUBPROCESSES */
414 return Qnil;
415 }
416
417 {
418 int nread;
419 int first = 1;
420 int total_read = 0;
421 Lisp_Object instream;
422 struct gcpro ngcpro1;
423
424 /* Enable sending signal if user quits below. */
425 call_process_exited = 0;
426
427 record_unwind_protect (call_process_cleanup,
428 Fcons (make_int (fd[0]), make_int (pid)));
429
430 /* FSFmacs calls Fset_buffer() here. We don't have to because
431 we can insert into buffers other than the current one. */
432 if (EQ (buffer, Qt))
433 XSETBUFFER (buffer, current_buffer);
434 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
435 #ifdef FILE_CODING
436 instream =
437 make_decoding_input_stream
438 (XLSTREAM (instream),
439 Fget_coding_system (Vcoding_system_for_read));
440 Lstream_set_character_mode (XLSTREAM (instream));
441 #endif
442 NGCPRO1 (instream);
443 while (1)
444 {
445 QUIT;
446 /* Repeatedly read until we've filled as much as possible
447 of the buffer size we have. But don't read
448 less than 1024--save that for the next bufferfull. */
449
450 nread = 0;
451 while (nread < bufsize - 1024)
452 {
453 ssize_t this_read
454 = Lstream_read (XLSTREAM (instream), bufptr + nread,
455 bufsize - nread);
456
457 if (this_read < 0)
458 goto give_up;
459
460 if (this_read == 0)
461 goto give_up_1;
462
463 nread += this_read;
464 }
465
466 give_up_1:
467
468 /* Now NREAD is the total amount of data in the buffer. */
469 if (nread == 0)
470 break;
471
472 #ifdef DOS_NT
473 /* Until we pull out of MULE things like
474 make_decoding_input_stream(), we do the following which is
475 less elegant. --marcpa */
476 {
477 int lf_count = 0;
478 if (NILP (Vbinary_process_output)) {
479 nread = crlf_to_lf(nread, bufptr, &lf_count);
480 }
481 }
482 #endif
483
484 total_read += nread;
485
486 if (!NILP (buffer))
487 buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr,
488 nread);
489
490 /* Make the buffer bigger as we continue to read more data,
491 but not past 64k. */
492 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
493 {
494 bufsize *= 2;
495 bufptr = (char *) alloca (bufsize);
496 }
497
498 if (!NILP (display) && INTERACTIVE)
499 {
500 first = 0;
501 redisplay ();
502 }
503 }
504 give_up:
505 Lstream_close (XLSTREAM (instream));
506 NUNGCPRO;
507
508 QUIT;
509 /* Wait for it to terminate, unless it already has. */
510 wait_for_termination (pid);
511
512 /* Don't kill any children that the subprocess may have left behind
513 when exiting. */
514 call_process_exited = 1;
515 unbind_to (speccount, Qnil);
516
517 if (synch_process_death)
518 return build_string (synch_process_death);
519 return make_int (synch_process_retcode);
520 }
521 }
522
523
524
525 /* Move the file descriptor FD so that its number is not less than MIN. *
526 The original file descriptor remains open. */
527 static int
528 relocate_fd (int fd, int min)
529 {
530 if (fd >= min)
531 return fd;
532 else
533 {
534 int newfd = dup (fd);
535 if (newfd == -1)
536 {
537 stderr_out ("Error while setting up child: %s\n",
538 strerror (errno));
539 _exit (1);
540 }
541 return relocate_fd (newfd, min);
542 }
543 }
544
545 /* This is the last thing run in a newly forked inferior
546 either synchronous or asynchronous.
547 Copy descriptors IN, OUT and ERR
548 as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO.
549 Initialize inferior's priority, pgrp, connected dir and environment.
550 then exec another program based on new_argv.
551
552 This function may change environ for the superior process.
553 Therefore, the superior process must save and restore the value
554 of environ around the fork and the call to this function.
555
556 ENV is the environment for the subprocess.
557
558 XEmacs: We've removed the SET_PGRP argument because it's already
559 done by the callers of child_setup.
560
561 CURRENT_DIR is an elisp string giving the path of the current
562 directory the subprocess should have. Since we can't really signal
563 a decent error from within the child, this should be verified as an
564 executable directory by the parent. */
565
566 #ifdef WINDOWSNT
567 int
568 #else
569 void
570 #endif
571 child_setup (int in, int out, int err, char **new_argv,
572 CONST char *current_dir)
573 {
574 char **env;
575 char *pwd;
576 #ifdef WINDOWSNT
577 int cpid;
578 HANDLE handles[4];
579 #endif /* WINDOWSNT */
580
581 #ifdef SET_EMACS_PRIORITY
582 if (emacs_priority != 0)
583 nice (- emacs_priority);
584 #endif
585
586 #if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT)
587 /* Close Emacs's descriptors that this process should not have. */
588 close_process_descs ();
589 #endif /* not NO_SUBPROCESSES */
590 close_load_descs ();
591
592 /* Note that use of alloca is always safe here. It's obvious for systems
593 that do not have true vfork or that have true (stack) alloca.
594 If using vfork and C_ALLOCA it is safe because that changes
595 the superior's static variables as if the superior had done alloca
596 and will be cleaned up in the usual way. */
597 {
598 REGISTER int i;
599
600 i = strlen (current_dir);
601 pwd = alloca_array (char, i + 6);
602 memcpy (pwd, "PWD=", 4);
603 memcpy (pwd + 4, current_dir, i);
604 i += 4;
605 if (!IS_DIRECTORY_SEP (pwd[i - 1]))
606 pwd[i++] = DIRECTORY_SEP;
607 pwd[i] = 0;
608
609 /* We can't signal an Elisp error here; we're in a vfork. Since
610 the callers check the current directory before forking, this
611 should only return an error if the directory's permissions
612 are changed between the check and this chdir, but we should
613 at least check. */
614 if (chdir (pwd + 4) < 0)
615 {
616 /* Don't report the chdir error, or ange-ftp.el doesn't work. */
617 /* (FSFmacs does _exit (errno) here.) */
618 pwd = 0;
619 }
620 else
621 {
622 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */
623 /* leave "//" (from FSF) */
624 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1]))
625 pwd[--i] = 0;
626 }
627 }
628
629 /* Set `env' to a vector of the strings in Vprocess_environment. */
630 /* + 2 to include PWD and terminating 0. */
631 env = alloca_array (char *, XINT (Flength (Vprocess_environment)) + 2);
632 {
633 REGISTER Lisp_Object tail;
634 char **new_env = env;
635
636 /* If we have a PWD envvar and we know the real current directory,
637 pass one down, but with corrected value. */
638 if (pwd && getenv ("PWD"))
639 *new_env++ = pwd;
640
641 /* Copy the Vprocess_environment strings into new_env. */
642 for (tail = Vprocess_environment;
643 CONSP (tail) && STRINGP (XCAR (tail));
644 tail = XCDR (tail))
645 {
646 char **ep = env;
647 char *envvar_external;
648 Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
649
650 GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external);
651
652 /* See if envvar_external duplicates any string already in the env.
653 If so, don't put it in.
654 When an env var has multiple definitions,
655 we keep the definition that comes first in process-environment. */
656 for (; ep != new_env; ep++)
657 {
658 char *p = *ep, *q = envvar_external;
659 while (1)
660 {
661 if (*q == 0)
662 /* The string is malformed; might as well drop it. */
663 goto duplicate;
664 if (*q != *p)
665 break;
666 if (*q == '=')
667 goto duplicate;
668 p++, q++;
669 }
670 }
671 if (pwd && !strncmp ("PWD=", envvar_external, 4))
672 {
673 *new_env++ = pwd;
674 pwd = 0;
675 }
676 else
677 *new_env++ = envvar_external;
678
679 duplicate: ;
680 }
681 *new_env = 0;
682 }
683
684 #ifdef WINDOWSNT
685 prepare_standard_handles (in, out, err, handles);
686 set_process_dir (current_dir);
687 #else /* not WINDOWSNT */
688 /* Make sure that in, out, and err are not actually already in
689 descriptors zero, one, or two; this could happen if Emacs is
690 started with its standard in, out, or error closed, as might
691 happen under X. */
692 in = relocate_fd (in, 3);
693 out = relocate_fd (out, 3);
694 err = relocate_fd (err, 3);
695
696 /* Set the standard input/output channels of the new process. */
697 close (STDIN_FILENO);
698 close (STDOUT_FILENO);
699 close (STDERR_FILENO);
700
701 dup2 (in, STDIN_FILENO);
702 dup2 (out, STDOUT_FILENO);
703 dup2 (err, STDERR_FILENO);
704
705 close (in);
706 close (out);
707 close (err);
708
709 /* I can't think of any reason why child processes need any more
710 than the standard 3 file descriptors. It would be cleaner to
711 close just the ones that need to be, but the following brute
712 force approach is certainly effective, and not too slow. */
713 {
714 int fd;
715 for (fd=3; fd<=64; fd++)
716 close (fd);
717 }
718 #endif /* not WINDOWSNT */
719
720 #ifdef vipc
721 something missing here;
722 #endif /* vipc */
723
724 #ifdef WINDOWSNT
725 /* Spawn the child. (See ntproc.c:Spawnve). */
726 cpid = spawnve (_P_NOWAIT, new_argv[0], (CONST char* CONST*)new_argv,
727 (CONST char* CONST*)env);
728 if (cpid == -1)
729 /* An error occurred while trying to spawn the process. */
730 report_file_error ("Spawning child process", Qnil);
731 reset_standard_handles (in, out, err, handles);
732 return cpid;
733 #else /* not WINDOWSNT */
734 /* execvp does not accept an environment arg so the only way
735 to pass this environment is to set environ. Our caller
736 is responsible for restoring the ambient value of environ. */
737 environ = env;
738 execvp (new_argv[0], new_argv);
739
740 stdout_out ("Can't exec program %s\n", new_argv[0]);
741 _exit (1);
742 #endif /* not WINDOWSNT */
743 }
744
745 static int
746 getenv_internal (CONST Bufbyte *var,
747 Bytecount varlen,
748 Bufbyte **value,
749 Bytecount *valuelen)
750 {
751 Lisp_Object scan;
752
753 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
754 {
755 Lisp_Object entry = XCAR (scan);
756
757 if (STRINGP (entry)
758 && XSTRING_LENGTH (entry) > varlen
759 && XSTRING_BYTE (entry, varlen) == '='
760 #ifdef WINDOWSNT
761 /* NT environment variables are case insensitive. */
762 && ! memicmp (XSTRING_DATA (entry), var, varlen)
763 #else /* not WINDOWSNT */
764 && ! memcmp (XSTRING_DATA (entry), var, varlen)
765 #endif /* not WINDOWSNT */
766 )
767 {
768 *value = XSTRING_DATA (entry) + (varlen + 1);
769 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
770 return 1;
771 }
772 }
773
774 return 0;
775 }
776
777 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /*
778 Return the value of environment variable VAR, as a string.
779 VAR is a string, the name of the variable.
780 When invoked interactively, prints the value in the echo area.
781 */
782 (var, interactivep))
783 {
784 Bufbyte *value;
785 Bytecount valuelen;
786 Lisp_Object v = Qnil;
787 struct gcpro gcpro1;
788
789 CHECK_STRING (var);
790 GCPRO1 (v);
791 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var),
792 &value, &valuelen))
793 v = make_string (value, valuelen);
794 if (!NILP (interactivep))
795 {
796 if (NILP (v))
797 message ("%s not defined in environment", XSTRING_DATA (var));
798 else
799 /* #### Should use Fprin1_to_string or Fprin1 to handle string
800 containing quotes correctly. */
801 message ("\"%s\"", value);
802 }
803 RETURN_UNGCPRO (v);
804 }
805
806 /* A version of getenv that consults process_environment, easily
807 callable from C. */
808 char *
809 egetenv (CONST char *var)
810 {
811 Bufbyte *value;
812 Bytecount valuelen;
813
814 if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen))
815 return (char *) value;
816 else
817 return 0;
818 }
819
820
821 void
822 init_callproc (void)
823 {
824 /* This function can GC */
825
826 {
827 /* jwz: always initialize Vprocess_environment, so that egetenv()
828 works in temacs. */
829 char **envp;
830 Vprocess_environment = Qnil;
831 for (envp = environ; envp && *envp; envp++)
832 {
833 Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
834 Vprocess_environment);
835 }
836 }
837
838 {
839 /* Initialize shell-file-name from environment variables or best guess. */
840 #ifdef WINDOWSNT
841 CONST char *shell = egetenv ("COMSPEC");
842 if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
843 #else /* not WINDOWSNT */
844 CONST char *shell = egetenv ("SHELL");
845 if (!shell) shell = "/bin/sh";
846 #endif
847
848 Vshell_file_name = build_string (shell);
849 }
850 }
851
852 #if 0
853 void
854 set_process_environment (void)
855 {
856 REGISTER char **envp;
857
858 Vprocess_environment = Qnil;
859 #ifndef CANNOT_DUMP
860 if (initialized)
861 #endif
862 for (envp = environ; *envp; envp++)
863 Vprocess_environment = Fcons (build_string (*envp),
864 Vprocess_environment);
865 }
866 #endif /* unused */
867
868 void
869 syms_of_callproc (void)
870 {
871 DEFSUBR (Fcall_process_internal);
872 DEFSUBR (Fgetenv);
873 }
874
875 void
876 vars_of_callproc (void)
877 {
878 /* This function can GC */
879 #ifdef DOS_NT
880 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
881 *If non-nil then new subprocesses are assumed to take binary input.
882 */ );
883 Vbinary_process_input = Qnil;
884
885 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
886 *If non-nil then new subprocesses are assumed to produce binary output.
887 */ );
888 Vbinary_process_output = Qnil;
889 #endif /* DOS_NT */
890
891 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
892 *File name to load inferior shells from.
893 Initialized from the SHELL environment variable.
894 */ );
895
896 DEFVAR_LISP ("process-environment", &Vprocess_environment /*
897 List of environment variables for subprocesses to inherit.
898 Each element should be a string of the form ENVVARNAME=VALUE.
899 The environment which Emacs inherits is placed in this variable
900 when Emacs starts.
901 */ );
902
903 Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES);
904 staticpro (&Vlisp_EXEC_SUFFIXES);
905 }