1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs 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 1, or (at your option)
11 GNU Emacs 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.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
28 extern char *sys_errlist
[];
31 /* Define SIGCHLD as an alias for SIGCLD. */
33 #if !defined (SIGCHLD) && defined (SIGCLD)
34 #define SIGCHLD SIGCLD
37 #include <sys/types.h>
57 #include "syssignal.h"
60 extern noshare
char **environ
;
62 extern char **environ
;
65 #define max(a, b) ((a) > (b) ? (a) : (b))
67 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
;
68 Lisp_Object Vconfigure_info_directory
;
70 Lisp_Object Vshell_file_name
;
72 Lisp_Object Vprocess_environment
;
74 /* True iff we are about to fork off a synchronous process or if we
75 are waiting for it. */
76 int synch_process_alive
;
78 /* Nonzero => this is a string explaining death of synchronous subprocess. */
79 char *synch_process_death
;
81 /* If synch_process_death is zero,
82 this is exit code of synchronous subprocess. */
83 int synch_process_retcode
;
85 #ifndef VMS /* VMS version is in vmsproc.c. */
88 call_process_kill (fdpid
)
91 close (XFASTINT (Fcar (fdpid
)));
92 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
93 synch_process_alive
= 0;
98 call_process_cleanup (fdpid
)
101 register int pid
= XFASTINT (Fcdr (fdpid
));
103 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
105 int count
= specpdl_ptr
- specpdl
;
106 record_unwind_protect (call_process_kill
, fdpid
);
107 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
110 wait_for_termination (pid
);
112 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
113 message1 ("Waiting for process to die...done");
115 synch_process_alive
= 0;
116 close (XFASTINT (Fcar (fdpid
)));
120 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
121 "Call PROGRAM synchronously in separate process.\n\
122 The program's input comes from file INFILE (nil means `/dev/null').\n\
123 Insert output in BUFFER before point; t means current buffer;\n\
124 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
125 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
126 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
127 If BUFFER is 0, returns immediately with value nil.\n\
128 Otherwise waits for PROGRAM to terminate\n\
129 and returns a numeric exit status or a signal description string.\n\
130 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
133 register Lisp_Object
*args
;
135 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
140 int count
= specpdl_ptr
- specpdl
;
141 register unsigned char **new_argv
142 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
143 struct buffer
*old
= current_buffer
;
147 CHECK_STRING (args
[0], 0);
149 if (nargs
>= 2 && ! NILP (args
[1]))
151 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
152 CHECK_STRING (infile
, 1);
155 infile
= build_string (NULL_DEVICE
);
159 register Lisp_Object tem
;
161 buffer
= tem
= args
[2];
164 || XFASTINT (tem
) == 0))
166 buffer
= Fget_buffer (tem
);
167 CHECK_BUFFER (buffer
, 2);
173 /* Make sure that the child will be able to chdir to the current
174 buffer's current directory, or its unhandled equivalent. We
175 can't just have the child check for an error when it does the
176 chdir, since it's in a vfork.
178 We have to GCPRO around this because Fexpand_file_name,
179 Funhandled_file_name_directory, and Ffile_accessible_directory_p
180 might call a file name handling function. The argument list is
181 protected by the caller, so all we really have to worry about is
184 struct gcpro gcpro1
, gcpro2
, gcpro3
;
186 current_dir
= current_buffer
->directory
;
188 GCPRO3 (infile
, buffer
, current_dir
);
191 expand_and_dir_to_file
192 (Funhandled_file_name_directory (current_dir
), Qnil
);
193 if (NILP (Ffile_accessible_directory_p (current_dir
)))
194 report_file_error ("Setting current directory",
195 Fcons (current_buffer
->directory
, Qnil
));
200 display
= nargs
>= 4 ? args
[3] : Qnil
;
204 for (i
= 4; i
< nargs
; i
++)
206 CHECK_STRING (args
[i
], i
);
207 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
209 /* Program name is first command arg */
210 new_argv
[0] = XSTRING (args
[0])->data
;
214 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
217 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
219 /* Search for program; barf if not found. */
220 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
224 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
226 new_argv
[0] = XSTRING (path
)->data
;
228 if (XTYPE (buffer
) == Lisp_Int
)
229 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
234 /* Replaced by close_process_descs */
235 set_exclusive_use (fd
[0]);
240 /* child_setup must clobber environ in systems with true vfork.
241 Protect it from permanent change. */
242 register char **save_environ
= environ
;
243 register int fd1
= fd
[1];
245 #if 0 /* Some systems don't have sigblock. */
246 mask
= sigblock (sigmask (SIGCHLD
));
249 /* Record that we're about to create a synchronous process. */
250 synch_process_alive
= 1;
252 /* These vars record information from process termination.
253 Clear them now before process can possibly terminate,
254 to avoid timing error if process terminates soon. */
255 synch_process_death
= 0;
256 synch_process_retcode
= 0;
269 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
273 /* Tell SIGCHLD handler to look for this pid. */
274 synch_process_pid
= pid
;
275 /* Now let SIGCHLD come through. */
279 environ
= save_environ
;
288 report_file_error ("Doing vfork", Qnil
);
291 if (XTYPE (buffer
) == Lisp_Int
)
294 /* If Emacs has been built with asynchronous subprocess support,
295 we don't need to do this, I think because it will then have
296 the facilities for handling SIGCHLD. */
297 wait_without_blocking ();
298 #endif /* subprocesses */
302 record_unwind_protect (call_process_cleanup
,
303 Fcons (make_number (fd
[0]), make_number (pid
)));
306 if (XTYPE (buffer
) == Lisp_Buffer
)
307 Fset_buffer (buffer
);
315 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
320 if (!NILP (display
) && INTERACTIVE
)
321 redisplay_preserve_echo_area ();
327 /* Wait for it to terminate, unless it already has. */
328 wait_for_termination (pid
);
332 set_buffer_internal (old
);
334 unbind_to (count
, Qnil
);
336 if (synch_process_death
)
337 return build_string (synch_process_death
);
338 return make_number (synch_process_retcode
);
343 delete_temp_file (name
)
346 unlink (XSTRING (name
)->data
);
349 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
351 "Send text from START to END to a synchronous process running PROGRAM.\n\
352 Delete the text if fourth arg DELETE is non-nil.\n\
353 Insert output in BUFFER before point; t means current buffer;\n\
354 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
355 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
356 Remaining args are passed to PROGRAM at startup as command args.\n\
357 If BUFFER is nil, returns immediately with value nil.\n\
358 Otherwise waits for PROGRAM to terminate\n\
359 and returns a numeric exit status or a signal description string.\n\
360 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
363 register Lisp_Object
*args
;
365 register Lisp_Object filename_string
, start
, end
;
367 int count
= specpdl_ptr
- specpdl
;
370 strcpy (tempfile
, "tmp:emacsXXXXXX.");
372 strcpy (tempfile
, "/tmp/emacsXXXXXX");
376 filename_string
= build_string (tempfile
);
379 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
380 record_unwind_protect (delete_temp_file
, filename_string
);
383 Fdelete_region (start
, end
);
385 args
[3] = filename_string
;
387 return unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2));
390 #ifndef VMS /* VMS version is in vmsproc.c. */
392 /* This is the last thing run in a newly forked inferior
393 either synchronous or asynchronous.
394 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
395 Initialize inferior's priority, pgrp, connected dir and environment.
396 then exec another program based on new_argv.
398 This function may change environ for the superior process.
399 Therefore, the superior process must save and restore the value
400 of environ around the vfork and the call to this function.
402 ENV is the environment for the subprocess.
404 SET_PGRP is nonzero if we should put the subprocess into a separate
407 CURRENT_DIR is an elisp string giving the path of the current
408 directory the subprocess should have. Since we can't really signal
409 a decent error from within the child, this should be verified as an
410 executable directory by the parent. */
412 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
414 register char **new_argv
;
416 Lisp_Object current_dir
;
420 register int pid
= getpid();
423 extern int emacs_priority
;
425 nice (- emacs_priority
);
429 /* Close Emacs's descriptors that this process should not have. */
430 close_process_descs ();
433 /* Note that use of alloca is always safe here. It's obvious for systems
434 that do not have true vfork or that have true (stack) alloca.
435 If using vfork and C_ALLOCA it is safe because that changes
436 the superior's static variables as if the superior had done alloca
437 and will be cleaned up in the usual way. */
439 register unsigned char *temp
;
442 i
= XSTRING (current_dir
)->size
;
443 temp
= (unsigned char *) alloca (i
+ 2);
444 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
445 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
448 /* We can't signal an Elisp error here; we're in a vfork. Since
449 the callers check the current directory before forking, this
450 should only return an error if the directory's permissions
451 are changed between the check and this chdir, but we should
453 if (chdir (temp
) < 0)
457 /* Set `env' to a vector of the strings in Vprocess_environment. */
459 register Lisp_Object tem
;
460 register char **new_env
;
461 register int new_length
;
464 for (tem
= Vprocess_environment
;
465 (XTYPE (tem
) == Lisp_Cons
466 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
467 tem
= XCONS (tem
)->cdr
)
470 /* new_length + 1 to include terminating 0. */
471 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
473 /* Copy the Vprocess_environment strings into new_env. */
474 for (tem
= Vprocess_environment
;
475 (XTYPE (tem
) == Lisp_Cons
476 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
477 tem
= XCONS (tem
)->cdr
)
480 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
481 /* See if this string duplicates any string already in the env.
482 If so, don't put it in.
483 When an env var has multiple definitions,
484 we keep the definition that comes first in process-environment. */
485 for (; ep
!= new_env
; ep
++)
487 char *p
= *ep
, *q
= string
;
491 /* The string is malformed; might as well drop it. */
506 /* Make sure that in, out, and err are not actually already in
507 descriptors zero, one, or two; this could happen if Emacs is
508 started with its standard in, our, or error closed, as might
510 in
= relocate_fd (in
, 3);
511 out
= relocate_fd (out
, 3);
512 err
= relocate_fd (err
, 3);
527 setpgrp (); /* No arguments but equivalent in this case */
532 setpgrp_of_tty (pid
);
535 something missing here
;
538 /* execvp does not accept an environment arg so the only way
539 to pass this environment is to set environ. Our caller
540 is responsible for restoring the ambient value of environ. */
542 execvp (new_argv
[0], new_argv
);
544 write (1, "Couldn't exec the program ", 26);
545 write (1, new_argv
[0], strlen (new_argv
[0]));
549 /* Move the file descriptor FD so that its number is not less than MIN.
550 If the file descriptor is moved at all, the original is freed. */
552 relocate_fd (fd
, min
)
562 char *message1
= "Error while setting up child: ";
563 char *message2
= "\n";
564 write (2, message1
, strlen (message1
));
565 write (2, sys_errlist
[errno
], strlen (sys_errlist
[errno
]));
566 write (2, message2
, strlen (message2
));
569 /* Note that we hold the original FD open while we recurse,
570 to guarantee we'll get a new FD if we need it. */
571 new = relocate_fd (new, min
);
578 getenv_internal (var
, varlen
, value
, valuelen
)
586 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
588 Lisp_Object entry
= XCONS (scan
)->car
;
590 if (XTYPE (entry
) == Lisp_String
591 && XSTRING (entry
)->size
> varlen
592 && XSTRING (entry
)->data
[varlen
] == '='
593 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
595 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
596 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
604 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 2, 0,
605 "Return the value of environment variable VAR, as a string.\n\
606 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
607 This function consults the variable ``process-environment'' for its value.")
614 CHECK_STRING (var
, 0);
615 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
617 return make_string (value
, valuelen
);
622 /* A version of getenv that consults process_environment, easily
631 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
645 char *data_dir
= egetenv ("EMACSDATA");
648 Ffile_name_as_directory
649 (build_string (data_dir
? data_dir
: PATH_DATA
));
652 /* Check the EMACSPATH environment variable, defaulting to the
653 PATH_EXEC path from paths.h. */
654 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
655 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
656 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
658 tempdir
= Fdirectory_file_name (Vexec_directory
);
659 if (access (XSTRING (tempdir
)->data
, 0) < 0)
661 printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
662 XSTRING (Vexec_directory
)->data
);
666 tempdir
= Fdirectory_file_name (Vdata_directory
);
667 if (access (XSTRING (tempdir
)->data
, 0) < 0)
669 printf ("Warning: arch-independent data dir (%s) does not exist.\n",
670 XSTRING (Vdata_directory
)->data
);
675 Vshell_file_name
= build_string ("*dcl*");
677 sh
= (char *) getenv ("SHELL");
678 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
682 set_process_environment ()
684 register char **envp
;
686 Vprocess_environment
= Qnil
;
690 for (envp
= environ
; *envp
; envp
++)
691 Vprocess_environment
= Fcons (build_string (*envp
),
692 Vprocess_environment
);
697 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
698 "*File name to load inferior shells from.\n\
699 Initialized from the SHELL environment variable.");
701 DEFVAR_LISP ("exec-path", &Vexec_path
,
702 "*List of directories to search programs to run in subprocesses.\n\
703 Each element is a string (directory name) or nil (try default directory).");
705 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
706 "Directory of architecture-dependent files that come with GNU Emacs,\n\
707 especially executable programs intended for Emacs to invoke.");
709 DEFVAR_LISP ("data-directory", &Vdata_directory
,
710 "Directory of architecture-independent files that come with GNU Emacs,\n\
711 intended for Emacs to use.");
713 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
714 "For internal use by the build procedure only.\n\
715 This is the name of the directory in which the build procedure installed\n\
716 Emacs's info files; the default value for Info-default-directory-list\n\
718 Vconfigure_info_directory
= build_string (PATH_INFO
);
720 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
721 "List of environment variables for subprocesses to inherit.\n\
722 Each element should be a string of the form ENVVARNAME=VALUE.\n\
723 The environment which Emacs inherits is placed in this variable\n\
724 when Emacs starts.");
727 defsubr (&Scall_process
);
730 defsubr (&Scall_process_region
);