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