296
|
1 /* Synchronous subprocess invocation for GNU Emacs.
|
934
|
2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
|
296
|
3
|
|
4 This file is part of GNU Emacs.
|
|
5
|
|
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)
|
|
9 any later version.
|
|
10
|
|
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.
|
|
15
|
|
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. */
|
|
19
|
|
20
|
|
21 #include <signal.h>
|
|
22
|
|
23 #include "config.h"
|
|
24
|
|
25 /* Define SIGCHLD as an alias for SIGCLD. */
|
|
26
|
|
27 #if !defined (SIGCHLD) && defined (SIGCLD)
|
|
28 #define SIGCHLD SIGCLD
|
|
29 #endif /* SIGCLD */
|
|
30
|
|
31 #include <sys/types.h>
|
|
32 #define PRIO_PROCESS 0
|
|
33 #include <sys/file.h>
|
|
34 #ifdef USG5
|
|
35 #include <fcntl.h>
|
|
36 #endif
|
|
37
|
|
38 #ifndef O_RDONLY
|
|
39 #define O_RDONLY 0
|
|
40 #endif
|
|
41
|
|
42 #ifndef O_WRONLY
|
|
43 #define O_WRONLY 1
|
|
44 #endif
|
|
45
|
|
46 #include "lisp.h"
|
|
47 #include "commands.h"
|
|
48 #include "buffer.h"
|
|
49 #include "paths.h"
|
|
50 #include "process.h"
|
|
51
|
|
52 #ifdef VMS
|
|
53 extern noshare char **environ;
|
|
54 #else
|
|
55 extern char **environ;
|
|
56 #endif
|
|
57
|
|
58 #define max(a, b) ((a) > (b) ? (a) : (b))
|
|
59
|
934
|
60 Lisp_Object Vexec_path, Vexec_directory;
|
296
|
61
|
|
62 Lisp_Object Vshell_file_name;
|
|
63
|
934
|
64 #ifndef MAINTAIN_ENVIRONMENT
|
|
65 /* List of strings to append to front of environment of
|
|
66 all subprocesses when they are started. */
|
|
67
|
296
|
68 Lisp_Object Vprocess_environment;
|
934
|
69 #endif
|
296
|
70
|
|
71 /* True iff we are about to fork off a synchronous process or if we
|
|
72 are waiting for it. */
|
|
73 int synch_process_alive;
|
|
74
|
|
75 /* Nonzero => this is a string explaining death of synchronous subprocess. */
|
|
76 char *synch_process_death;
|
|
77
|
|
78 /* If synch_process_death is zero,
|
|
79 this is exit code of synchronous subprocess. */
|
|
80 int synch_process_retcode;
|
|
81
|
|
82 #ifndef VMS /* VMS version is in vmsproc.c. */
|
|
83
|
|
84 Lisp_Object
|
|
85 call_process_cleanup (fdpid)
|
|
86 Lisp_Object fdpid;
|
|
87 {
|
|
88 register Lisp_Object fd, pid;
|
|
89 fd = Fcar (fdpid);
|
|
90 pid = Fcdr (fdpid);
|
|
91 close (XFASTINT (fd));
|
|
92 kill (XFASTINT (pid), SIGKILL);
|
|
93 synch_process_alive = 0;
|
|
94 return Qnil;
|
|
95 }
|
|
96
|
|
97 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
|
|
98 "Call PROGRAM synchronously in separate process.\n\
|
|
99 The program's input comes from file INFILE (nil means `/dev/null').\n\
|
|
100 Insert output in BUFFER before point; t means current buffer;\n\
|
|
101 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
|
|
102 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
|
|
103 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
|
|
104 If BUFFER is nil or 0, returns immediately with value nil.\n\
|
|
105 Otherwise waits for PROGRAM to terminate\n\
|
934
|
106 and returns a numeric exit status or a signal name as a string.\n\
|
296
|
107 If you quit, the process is killed with SIGKILL.")
|
|
108 (nargs, args)
|
|
109 int nargs;
|
|
110 register Lisp_Object *args;
|
|
111 {
|
934
|
112 Lisp_Object display, buffer, path;
|
296
|
113 int fd[2];
|
|
114 int filefd;
|
|
115 register int pid;
|
|
116 char buf[1024];
|
|
117 int count = specpdl_ptr - specpdl;
|
|
118 register unsigned char **new_argv
|
|
119 = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
|
|
120 struct buffer *old = current_buffer;
|
|
121 #if 0
|
|
122 int mask;
|
|
123 #endif
|
934
|
124 struct gcpro gcpro1;
|
|
125
|
|
126 GCPRO1 (*args);
|
|
127 gcpro1.nvars = nargs;
|
|
128
|
296
|
129 CHECK_STRING (args[0], 0);
|
|
130
|
934
|
131 if (nargs <= 1 || NULL (args[1]))
|
|
132 args[1] = build_string ("/dev/null");
|
296
|
133 else
|
934
|
134 args[1] = Fexpand_file_name (args[1], current_buffer->directory);
|
|
135
|
|
136 CHECK_STRING (args[1], 1);
|
648
|
137
|
934
|
138 {
|
|
139 register Lisp_Object tem;
|
|
140 buffer = tem = args[2];
|
|
141 if (nargs <= 2)
|
|
142 buffer = Qnil;
|
|
143 else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
|
|
144 || XFASTINT (tem) == 0))
|
|
145 {
|
|
146 buffer = Fget_buffer (tem);
|
|
147 CHECK_BUFFER (buffer, 2);
|
|
148 }
|
|
149 }
|
296
|
150
|
934
|
151 display = nargs >= 3 ? args[3] : Qnil;
|
296
|
152
|
|
153 {
|
|
154 register int i;
|
|
155 for (i = 4; i < nargs; i++)
|
|
156 {
|
|
157 CHECK_STRING (args[i], i);
|
|
158 new_argv[i - 3] = XSTRING (args[i])->data;
|
|
159 }
|
|
160 /* Program name is first command arg */
|
|
161 new_argv[0] = XSTRING (args[0])->data;
|
|
162 new_argv[i - 3] = 0;
|
|
163 }
|
|
164
|
934
|
165 filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
|
296
|
166 if (filefd < 0)
|
|
167 {
|
934
|
168 report_file_error ("Opening process input file", Fcons (args[1], Qnil));
|
296
|
169 }
|
|
170 /* Search for program; barf if not found. */
|
|
171 openp (Vexec_path, args[0], "", &path, 1);
|
934
|
172 if (NULL (path))
|
296
|
173 {
|
|
174 close (filefd);
|
|
175 report_file_error ("Searching for program", Fcons (args[0], Qnil));
|
|
176 }
|
|
177 new_argv[0] = XSTRING (path)->data;
|
|
178
|
|
179 if (XTYPE (buffer) == Lisp_Int)
|
|
180 fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
|
|
181 else
|
|
182 {
|
|
183 pipe (fd);
|
|
184 #if 0
|
|
185 /* Replaced by close_process_descs */
|
|
186 set_exclusive_use (fd[0]);
|
|
187 #endif
|
|
188 }
|
|
189
|
|
190 {
|
|
191 /* child_setup must clobber environ in systems with true vfork.
|
|
192 Protect it from permanent change. */
|
|
193 register char **save_environ = environ;
|
|
194 register int fd1 = fd[1];
|
934
|
195 char **env;
|
|
196
|
|
197 #ifdef MAINTAIN_ENVIRONMENT
|
|
198 env = (char **) alloca (size_of_current_environ ());
|
|
199 get_current_environ (env);
|
|
200 #else
|
|
201 env = environ;
|
|
202 #endif /* MAINTAIN_ENVIRONMENT */
|
296
|
203
|
|
204 #if 0 /* Some systems don't have sigblock. */
|
638
|
205 mask = sigblock (sigmask (SIGCHLD));
|
296
|
206 #endif
|
|
207
|
|
208 /* Record that we're about to create a synchronous process. */
|
|
209 synch_process_alive = 1;
|
|
210
|
|
211 pid = vfork ();
|
|
212
|
|
213 if (pid == 0)
|
|
214 {
|
|
215 if (fd[0] >= 0)
|
|
216 close (fd[0]);
|
|
217 #ifdef USG
|
|
218 setpgrp ();
|
|
219 #else
|
|
220 setpgrp (pid, pid);
|
|
221 #endif /* USG */
|
934
|
222 child_setup (filefd, fd1, fd1, new_argv, env, 0);
|
296
|
223 }
|
|
224
|
|
225 #if 0
|
|
226 /* Tell SIGCHLD handler to look for this pid. */
|
|
227 synch_process_pid = pid;
|
|
228 /* Now let SIGCHLD come through. */
|
638
|
229 sigsetmask (mask);
|
296
|
230 #endif
|
|
231
|
|
232 environ = save_environ;
|
|
233
|
|
234 close (filefd);
|
|
235 close (fd1);
|
|
236 }
|
|
237
|
|
238 if (pid < 0)
|
|
239 {
|
|
240 close (fd[0]);
|
|
241 report_file_error ("Doing vfork", Qnil);
|
|
242 }
|
|
243
|
|
244 if (XTYPE (buffer) == Lisp_Int)
|
|
245 {
|
|
246 #ifndef subprocesses
|
|
247 wait_without_blocking ();
|
|
248 #endif /* subprocesses */
|
934
|
249
|
|
250 UNGCPRO;
|
296
|
251 return Qnil;
|
|
252 }
|
|
253
|
|
254 record_unwind_protect (call_process_cleanup,
|
|
255 Fcons (make_number (fd[0]), make_number (pid)));
|
|
256
|
|
257
|
|
258 if (XTYPE (buffer) == Lisp_Buffer)
|
|
259 Fset_buffer (buffer);
|
|
260
|
|
261 immediate_quit = 1;
|
|
262 QUIT;
|
|
263
|
|
264 {
|
|
265 register int nread;
|
|
266
|
|
267 while ((nread = read (fd[0], buf, sizeof buf)) > 0)
|
|
268 {
|
|
269 immediate_quit = 0;
|
934
|
270 if (!NULL (buffer))
|
296
|
271 insert (buf, nread);
|
934
|
272 if (!NULL (display) && INTERACTIVE)
|
296
|
273 redisplay_preserve_echo_area ();
|
|
274 immediate_quit = 1;
|
|
275 QUIT;
|
|
276 }
|
|
277 }
|
|
278
|
|
279 /* Wait for it to terminate, unless it already has. */
|
|
280 wait_for_termination (pid);
|
|
281
|
|
282 immediate_quit = 0;
|
|
283
|
|
284 set_buffer_internal (old);
|
|
285
|
|
286 unbind_to (count, Qnil);
|
|
287
|
934
|
288 UNGCPRO;
|
|
289
|
296
|
290 if (synch_process_death)
|
|
291 return build_string (synch_process_death);
|
|
292 return make_number (synch_process_retcode);
|
|
293 }
|
|
294 #endif
|
|
295
|
|
296 static void
|
|
297 delete_temp_file (name)
|
|
298 Lisp_Object name;
|
|
299 {
|
|
300 unlink (XSTRING (name)->data);
|
|
301 }
|
|
302
|
|
303 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
|
|
304 3, MANY, 0,
|
|
305 "Send text from START to END to a synchronous process running PROGRAM.\n\
|
|
306 Delete the text if fourth arg DELETE is non-nil.\n\
|
|
307 Insert output in BUFFER before point; t means current buffer;\n\
|
|
308 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
|
|
309 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
|
|
310 Remaining args are passed to PROGRAM at startup as command args.\n\
|
|
311 If BUFFER is nil, returns immediately with value nil.\n\
|
|
312 Otherwise waits for PROGRAM to terminate\n\
|
934
|
313 and returns a numeric exit status or a signal name as a string.\n\
|
296
|
314 If you quit, the process is killed with SIGKILL.")
|
|
315 (nargs, args)
|
|
316 int nargs;
|
|
317 register Lisp_Object *args;
|
|
318 {
|
|
319 register Lisp_Object filename_string, start, end;
|
|
320 char tempfile[20];
|
|
321 int count = specpdl_ptr - specpdl;
|
934
|
322 struct gcpro gcpro1;
|
|
323
|
|
324 GCPRO1 (*args);
|
|
325 gcpro1.nvars = 2;
|
296
|
326
|
|
327 #ifdef VMS
|
|
328 strcpy (tempfile, "tmp:emacsXXXXXX.");
|
|
329 #else
|
|
330 strcpy (tempfile, "/tmp/emacsXXXXXX");
|
|
331 #endif
|
|
332 mktemp (tempfile);
|
|
333
|
|
334 filename_string = build_string (tempfile);
|
|
335 start = args[0];
|
|
336 end = args[1];
|
|
337 Fwrite_region (start, end, filename_string, Qnil, Qlambda);
|
|
338 record_unwind_protect (delete_temp_file, filename_string);
|
|
339
|
934
|
340 if (!NULL (args[3]))
|
296
|
341 Fdelete_region (start, end);
|
|
342
|
|
343 args[3] = filename_string;
|
|
344 Fcall_process (nargs - 2, args + 2);
|
|
345
|
934
|
346 UNGCPRO;
|
296
|
347 return unbind_to (count, Qnil);
|
|
348 }
|
|
349
|
|
350 #ifndef VMS /* VMS version is in vmsproc.c. */
|
|
351
|
|
352 /* This is the last thing run in a newly forked inferior
|
|
353 either synchronous or asynchronous.
|
|
354 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
|
|
355 Initialize inferior's priority, pgrp, connected dir and environment.
|
|
356 then exec another program based on new_argv.
|
|
357
|
|
358 This function may change environ for the superior process.
|
|
359 Therefore, the superior process must save and restore the value
|
|
360 of environ around the vfork and the call to this function.
|
|
361
|
|
362 ENV is the environment for the subprocess.
|
|
363
|
|
364 SET_PGRP is nonzero if we should put the subprocess into a separate
|
934
|
365 process group. */
|
296
|
366
|
934
|
367 child_setup (in, out, err, new_argv, env, set_pgrp)
|
296
|
368 int in, out, err;
|
|
369 register char **new_argv;
|
934
|
370 char **env;
|
296
|
371 int set_pgrp;
|
|
372 {
|
|
373 register int pid = getpid();
|
|
374
|
|
375 setpriority (PRIO_PROCESS, pid, 0);
|
|
376
|
|
377 #ifdef subprocesses
|
|
378 /* Close Emacs's descriptors that this process should not have. */
|
|
379 close_process_descs ();
|
|
380 #endif
|
|
381
|
|
382 /* Note that use of alloca is always safe here. It's obvious for systems
|
|
383 that do not have true vfork or that have true (stack) alloca.
|
|
384 If using vfork and C_ALLOCA it is safe because that changes
|
|
385 the superior's static variables as if the superior had done alloca
|
|
386 and will be cleaned up in the usual way. */
|
|
387
|
934
|
388 if (XTYPE (current_buffer->directory) == Lisp_String)
|
|
389 {
|
|
390 register unsigned char *temp;
|
|
391 register int i;
|
538
|
392
|
934
|
393 i = XSTRING (current_buffer->directory)->size;
|
|
394 temp = (unsigned char *) alloca (i + 2);
|
|
395 bcopy (XSTRING (current_buffer->directory)->data, temp, i);
|
|
396 if (temp[i - 1] != '/') temp[i++] = '/';
|
|
397 temp[i] = 0;
|
|
398 /* Switch to that directory, and report any error. */
|
|
399 if (chdir (temp) < 0)
|
|
400 report_file_error ("In chdir",
|
|
401 Fcons (current_buffer->directory, Qnil));
|
|
402 }
|
296
|
403
|
934
|
404 #ifndef MAINTAIN_ENVIRONMENT
|
296
|
405 /* Set `env' to a vector of the strings in Vprocess_environment. */
|
|
406 {
|
|
407 register Lisp_Object tem;
|
|
408 register char **new_env;
|
|
409 register int new_length;
|
|
410
|
|
411 new_length = 0;
|
|
412 for (tem = Vprocess_environment;
|
|
413 (XTYPE (tem) == Lisp_Cons
|
|
414 && XTYPE (XCONS (tem)->car) == Lisp_String);
|
|
415 tem = XCONS (tem)->cdr)
|
|
416 new_length++;
|
|
417
|
|
418 /* new_length + 1 to include terminating 0 */
|
|
419 env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
|
|
420
|
934
|
421 /* Copy the env strings into new_env. */
|
296
|
422 for (tem = Vprocess_environment;
|
|
423 (XTYPE (tem) == Lisp_Cons
|
|
424 && XTYPE (XCONS (tem)->car) == Lisp_String);
|
|
425 tem = XCONS (tem)->cdr)
|
|
426 *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
|
|
427 *new_env = 0;
|
|
428 }
|
934
|
429 #endif /* Not MAINTAIN_ENVIRONMENT */
|
296
|
430
|
|
431 close (0);
|
|
432 close (1);
|
|
433 close (2);
|
|
434
|
|
435 dup2 (in, 0);
|
|
436 dup2 (out, 1);
|
|
437 dup2 (err, 2);
|
|
438 close (in);
|
|
439 close (out);
|
|
440 close (err);
|
|
441
|
|
442 setpgrp_of_tty (pid);
|
|
443
|
|
444 #ifdef vipc
|
|
445 something missing here;
|
|
446 #endif /* vipc */
|
|
447
|
|
448 /* execvp does not accept an environment arg so the only way
|
|
449 to pass this environment is to set environ. Our caller
|
|
450 is responsible for restoring the ambient value of environ. */
|
|
451 environ = env;
|
|
452 execvp (new_argv[0], new_argv);
|
|
453
|
|
454 write (1, "Couldn't exec the program ", 26);
|
|
455 write (1, new_argv[0], strlen (new_argv[0]));
|
|
456 _exit (1);
|
|
457 }
|
|
458
|
|
459 #endif /* not VMS */
|
|
460
|
|
461 init_callproc ()
|
|
462 {
|
|
463 register char * sh;
|
|
464 register char **envp;
|
934
|
465 Lisp_Object execdir;
|
439
|
466
|
934
|
467 /* Turn PATH_EXEC into a path. `==' is just a string which we know
|
|
468 will not be the name of an environment variable. */
|
|
469 Vexec_path = decode_env_path ("==", PATH_EXEC);
|
296
|
470 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
|
|
471 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
|
|
472
|
934
|
473 execdir = Fdirectory_file_name (Vexec_directory);
|
|
474 if (access (XSTRING (execdir)->data, 0) < 0)
|
296
|
475 {
|
934
|
476 printf ("Warning: executable/documentation dir (%s) does not exist.\n",
|
296
|
477 XSTRING (Vexec_directory)->data);
|
|
478 sleep (2);
|
|
479 }
|
|
480
|
|
481 #ifdef VMS
|
|
482 Vshell_file_name = build_string ("*dcl*");
|
|
483 #else
|
934
|
484 sh = (char *) egetenv ("SHELL");
|
296
|
485 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
|
|
486 #endif
|
|
487
|
934
|
488 #ifndef MAINTAIN_ENVIRONMENT
|
|
489 /* The equivalent of this operation was done
|
|
490 in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
|
296
|
491 Vprocess_environment = Qnil;
|
|
492 #ifndef CANNOT_DUMP
|
|
493 if (initialized)
|
|
494 #endif
|
|
495 for (envp = environ; *envp; envp++)
|
|
496 Vprocess_environment = Fcons (build_string (*envp),
|
|
497 Vprocess_environment);
|
934
|
498 #endif /* MAINTAIN_ENVIRONMENT */
|
296
|
499 }
|
|
500
|
|
501 syms_of_callproc ()
|
|
502 {
|
|
503 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
|
|
504 "*File name to load inferior shells from.\n\
|
|
505 Initialized from the SHELL environment variable.");
|
|
506
|
|
507 DEFVAR_LISP ("exec-path", &Vexec_path,
|
|
508 "*List of directories to search programs to run in subprocesses.\n\
|
|
509 Each element is a string (directory name) or nil (try default directory).");
|
|
510
|
|
511 DEFVAR_LISP ("exec-directory", &Vexec_directory,
|
934
|
512 "Directory that holds programs that come with GNU Emacs,\n\
|
|
513 intended for Emacs to invoke.");
|
439
|
514
|
934
|
515 #ifndef MAINTAIN_ENVIRONMENT
|
296
|
516 DEFVAR_LISP ("process-environment", &Vprocess_environment,
|
934
|
517 "List of strings to append to environment of subprocesses that are started.\n\
|
|
518 Each string should have the format ENVVARNAME=VALUE.");
|
|
519 #endif
|
296
|
520
|
|
521 #ifndef VMS
|
|
522 defsubr (&Scall_process);
|
|
523 #endif
|
|
524 defsubr (&Scall_process_region);
|
|
525 }
|