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