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;
263 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
267 /* Tell SIGCHLD handler to look for this pid. */
268 synch_process_pid
= pid
;
269 /* Now let SIGCHLD come through. */
273 environ
= save_environ
;
282 report_file_error ("Doing vfork", Qnil
);
285 if (XTYPE (buffer
) == Lisp_Int
)
288 /* If Emacs has been built with asynchronous subprocess support,
289 we don't need to do this, I think because it will then have
290 the facilities for handling SIGCHLD. */
291 wait_without_blocking ();
292 #endif /* subprocesses */
296 synch_process_death
= 0;
297 synch_process_retcode
= 0;
299 record_unwind_protect (call_process_cleanup
,
300 Fcons (make_number (fd
[0]), make_number (pid
)));
303 if (XTYPE (buffer
) == Lisp_Buffer
)
304 Fset_buffer (buffer
);
312 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
317 if (!NILP (display
) && INTERACTIVE
)
318 redisplay_preserve_echo_area ();
324 /* Wait for it to terminate, unless it already has. */
325 wait_for_termination (pid
);
329 set_buffer_internal (old
);
331 unbind_to (count
, Qnil
);
333 if (synch_process_death
)
334 return build_string (synch_process_death
);
335 return make_number (synch_process_retcode
);
340 delete_temp_file (name
)
343 unlink (XSTRING (name
)->data
);
346 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
348 "Send text from START to END to a synchronous process running PROGRAM.\n\
349 Delete the text if fourth arg DELETE is non-nil.\n\
350 Insert output in BUFFER before point; t means current buffer;\n\
351 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
352 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
353 Remaining args are passed to PROGRAM at startup as command args.\n\
354 If BUFFER is nil, returns immediately with value nil.\n\
355 Otherwise waits for PROGRAM to terminate\n\
356 and returns a numeric exit status or a signal description string.\n\
357 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
360 register Lisp_Object
*args
;
362 register Lisp_Object filename_string
, start
, end
;
364 int count
= specpdl_ptr
- specpdl
;
367 strcpy (tempfile
, "tmp:emacsXXXXXX.");
369 strcpy (tempfile
, "/tmp/emacsXXXXXX");
373 filename_string
= build_string (tempfile
);
376 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
377 record_unwind_protect (delete_temp_file
, filename_string
);
380 Fdelete_region (start
, end
);
382 args
[3] = filename_string
;
384 return unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2));
387 #ifndef VMS /* VMS version is in vmsproc.c. */
389 /* This is the last thing run in a newly forked inferior
390 either synchronous or asynchronous.
391 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
392 Initialize inferior's priority, pgrp, connected dir and environment.
393 then exec another program based on new_argv.
395 This function may change environ for the superior process.
396 Therefore, the superior process must save and restore the value
397 of environ around the vfork and the call to this function.
399 ENV is the environment for the subprocess.
401 SET_PGRP is nonzero if we should put the subprocess into a separate
404 CURRENT_DIR is an elisp string giving the path of the current
405 directory the subprocess should have. Since we can't really signal
406 a decent error from within the child, this should be verified as an
407 executable directory by the parent. */
409 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
411 register char **new_argv
;
413 Lisp_Object current_dir
;
417 register int pid
= getpid();
420 extern int emacs_priority
;
422 nice (- emacs_priority
);
426 /* Close Emacs's descriptors that this process should not have. */
427 close_process_descs ();
430 /* Note that use of alloca is always safe here. It's obvious for systems
431 that do not have true vfork or that have true (stack) alloca.
432 If using vfork and C_ALLOCA it is safe because that changes
433 the superior's static variables as if the superior had done alloca
434 and will be cleaned up in the usual way. */
436 register unsigned char *temp
;
439 i
= XSTRING (current_dir
)->size
;
440 temp
= (unsigned char *) alloca (i
+ 2);
441 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
442 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
445 /* We can't signal an Elisp error here; we're in a vfork. Since
446 the callers check the current directory before forking, this
447 should only return an error if the directory's permissions
448 are changed between the check and this chdir, but we should
450 if (chdir (temp
) < 0)
454 /* Set `env' to a vector of the strings in Vprocess_environment. */
456 register Lisp_Object tem
;
457 register char **new_env
;
458 register int new_length
;
461 for (tem
= Vprocess_environment
;
462 (XTYPE (tem
) == Lisp_Cons
463 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
464 tem
= XCONS (tem
)->cdr
)
467 /* new_length + 1 to include terminating 0. */
468 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
470 /* Copy the Vprocess_environment strings into new_env. */
471 for (tem
= Vprocess_environment
;
472 (XTYPE (tem
) == Lisp_Cons
473 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
474 tem
= XCONS (tem
)->cdr
)
477 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
478 /* See if this string duplicates any string already in the env.
479 If so, don't put it in.
480 When an env var has multiple definitions,
481 we keep the definition that comes first in process-environment. */
482 for (; ep
!= new_env
; ep
++)
484 char *p
= *ep
, *q
= string
;
488 /* The string is malformed; might as well drop it. */
503 /* Make sure that in, out, and err are not actually already in
504 descriptors zero, one, or two; this could happen if Emacs is
505 started with its standard in, our, or error closed, as might
507 in
= relocate_fd (in
, 3);
508 out
= relocate_fd (out
, 3);
509 err
= relocate_fd (err
, 3);
524 setpgrp (); /* No arguments but equivalent in this case */
529 setpgrp_of_tty (pid
);
532 something missing here
;
535 /* execvp does not accept an environment arg so the only way
536 to pass this environment is to set environ. Our caller
537 is responsible for restoring the ambient value of environ. */
539 execvp (new_argv
[0], new_argv
);
541 write (1, "Couldn't exec the program ", 26);
542 write (1, new_argv
[0], strlen (new_argv
[0]));
546 /* Move the file descriptor FD so that its number is not less than MIN.
547 If the file descriptor is moved at all, the original is freed. */
549 relocate_fd (fd
, min
)
559 char *message1
= "Error while setting up child: ";
560 char *message2
= "\n";
561 write (2, message1
, strlen (message1
));
562 write (2, sys_errlist
[errno
], strlen (sys_errlist
[errno
]));
563 write (2, message2
, strlen (message2
));
566 /* Note that we hold the original FD open while we recurse,
567 to guarantee we'll get a new FD if we need it. */
568 new = relocate_fd (new, min
);
575 getenv_internal (var
, varlen
, value
, valuelen
)
583 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
585 Lisp_Object entry
= XCONS (scan
)->car
;
587 if (XTYPE (entry
) == Lisp_String
588 && XSTRING (entry
)->size
> varlen
589 && XSTRING (entry
)->data
[varlen
] == '='
590 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
592 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
593 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
601 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 2, 0,
602 "Return the value of environment variable VAR, as a string.\n\
603 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
604 This function consults the variable ``process-environment'' for its value.")
611 CHECK_STRING (var
, 0);
612 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
614 return make_string (value
, valuelen
);
619 /* A version of getenv that consults process_environment, easily
628 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
642 char *data_dir
= egetenv ("EMACSDATA");
645 Ffile_name_as_directory
646 (build_string (data_dir
? data_dir
: PATH_DATA
));
649 /* Check the EMACSPATH environment variable, defaulting to the
650 PATH_EXEC path from paths.h. */
651 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
652 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
653 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
655 tempdir
= Fdirectory_file_name (Vexec_directory
);
656 if (access (XSTRING (tempdir
)->data
, 0) < 0)
658 printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
659 XSTRING (Vexec_directory
)->data
);
663 tempdir
= Fdirectory_file_name (Vdata_directory
);
664 if (access (XSTRING (tempdir
)->data
, 0) < 0)
666 printf ("Warning: arch-independent data dir (%s) does not exist.\n",
667 XSTRING (Vdata_directory
)->data
);
672 Vshell_file_name
= build_string ("*dcl*");
674 sh
= (char *) getenv ("SHELL");
675 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
679 set_process_environment ()
681 register char **envp
;
683 Vprocess_environment
= Qnil
;
687 for (envp
= environ
; *envp
; envp
++)
688 Vprocess_environment
= Fcons (build_string (*envp
),
689 Vprocess_environment
);
694 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
695 "*File name to load inferior shells from.\n\
696 Initialized from the SHELL environment variable.");
698 DEFVAR_LISP ("exec-path", &Vexec_path
,
699 "*List of directories to search programs to run in subprocesses.\n\
700 Each element is a string (directory name) or nil (try default directory).");
702 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
703 "Directory of architecture-dependent files that come with GNU Emacs,\n\
704 especially executable programs intended for Emacs to invoke.");
706 DEFVAR_LISP ("data-directory", &Vdata_directory
,
707 "Directory of architecture-independent files that come with GNU Emacs,\n\
708 intended for Emacs to use.");
710 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
711 "For internal use by the build procedure only.\n\
712 This is the name of the directory in which the build procedure installed\n\
713 Emacs's info files; the default value for Info-default-directory-list\n\
715 Vconfigure_info_directory
= build_string (PATH_INFO
);
717 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
718 "List of environment variables for subprocesses to inherit.\n\
719 Each element should be a string of the form ENVVARNAME=VALUE.\n\
720 The environment which Emacs inherits is placed in this variable\n\
721 when Emacs starts.");
724 defsubr (&Scall_process
);
727 defsubr (&Scall_process_region
);