![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to callproc.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Synchronous subprocess invocation for GNU Emacs.
2: Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <signal.h>
23:
24: #include "config.h"
25:
26: #include <sys/types.h>
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: Lisp_Object
67: call_process_cleanup (fdpid)
68: Lisp_Object fdpid;
69: {
70: register Lisp_Object fd, pid;
71: fd = Fcar (fdpid);
72: pid = Fcdr (fdpid);
73: close (XFASTINT (fd));
74: kill (XFASTINT (pid), SIGKILL);
75: return Qnil;
76: }
77:
78: #ifdef VMS
79: extern noshare char **environ;
80: #else
81: extern char **environ;
82: #endif
83:
84: DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
85: "Call PROGRAM in separate process.\n\
86: Program's input comes from file INFILE (nil means /dev/null).\n\
87: Insert output in BUFFER before point; t means current buffer;\n\
88: nil for BUFFER means discard it; 0 means discard and don't wait.\n\
89: Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
90: Remaining arguments are strings passed as command arguments to PROGRAM.\n\
91: This function waits for PROGRAM to terminate;\n\
92: if you quit, the process is killed.")
93: (nargs, args)
94: int nargs;
95: register Lisp_Object *args;
96: {
97: Lisp_Object display, buffer, path;
98: int fd[2];
99: int filefd;
100: register int pid;
101: char buf[1024];
102: int count = specpdl_ptr - specpdl;
103: register unsigned char **new_argv
104: = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
105: struct buffer *old = bf_cur;
106:
107: CHECK_STRING (args[0], 0);
108:
109: if (nargs <= 1 || NULL (args[1]))
110: #ifdef VMS
111: args[1] = build_string ("NLA0:");
112: #else
113: args[1] = build_string ("/dev/null");
114: #endif /* not VMS */
115: else
116: args[1] = Fexpand_file_name (args[1], bf_cur->directory);
117:
118: CHECK_STRING (args[1], 1);
119:
120: {
121: register Lisp_Object tem;
122: buffer = tem = args[2];
123: if (nargs <= 2)
124: buffer = Qnil;
125: else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
126: || XFASTINT (tem) == 0))
127: {
128: buffer = Fget_buffer (tem);
129: CHECK_BUFFER (buffer, 2);
130: }
131: }
132:
133: display = nargs >= 3 ? args[3] : Qnil;
134:
135: {
136: register int i;
137: for (i = 4; i < nargs; i++)
138: {
139: CHECK_STRING (args[i], i);
140: new_argv[i - 3] = XSTRING (args[i])->data;
141: }
142: /* Program name is first command arg */
143: new_argv[0] = XSTRING (args[0])->data;
144: new_argv[i - 3] = 0;
145: }
146:
147: filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
148: if (filefd < 0)
149: {
150: report_file_error ("Opening process input file", Fcons (args[1], Qnil));
151: }
152: /* Search for program; barf if not found. */
153: openp (Vexec_path, args[0], "", &path, 1);
154: if (NULL (path))
155: {
156: close (filefd);
157: report_file_error ("Searching for program", Fcons (args[0], Qnil));
158: }
159: new_argv[0] = XSTRING (path)->data;
160:
161: if (XTYPE (buffer) == Lisp_Int)
162: #ifdef VMS
163: fd[1] = open ("NLA0:", 0), fd[0] = -1;
164: #else
165: fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
166: #endif /* not VMS */
167: else
168: {
169: pipe (fd);
170: #if 0
171: /* Replaced by close_process_descs */
172: set_exclusive_use (fd[0]);
173: #endif
174: }
175:
176: {
177: /* child_setup must clobber environ in systems with true vfork.
178: Protect it from permanent change. */
179: register char **save_environ = environ;
180: register int fd1 = fd[1];
181: char **env;
182:
183: #ifdef MAINTAIN_ENVIRONMENT
184: env = (char **) alloca (size_of_current_environ ());
185: get_current_environ (env);
186: #else
187: env = environ;
188: #endif /* MAINTAIN_ENVIRONMENT */
189:
190: pid = vfork ();
191: #ifdef BSD4_1
192: /* cause SIGCHLD interrupts to look for this pid. */
193: synch_process_pid = pid;
194: #endif /* BSD4_1 */
195:
196: if (pid == 0)
197: {
198: if (fd[0] >= 0)
199: close (fd[0]);
200: #ifdef USG
201: #ifdef HAVE_PTYS
202: setpgrp ();
203: #endif
204: #endif
205: child_setup (filefd, fd1, fd1, new_argv, env);
206: }
207:
208: environ = save_environ;
209:
210: close (filefd);
211: close (fd1);
212: }
213:
214: if (pid < 0)
215: {
216: close (fd[0]);
217: report_file_error ("Doing vfork", Qnil);
218: }
219:
220: if (XTYPE (buffer) == Lisp_Int)
221: {
222: #ifndef subprocesses
223: wait_without_blocking ();
224: #endif subprocesses
225: return Qnil;
226: }
227:
228: record_unwind_protect (call_process_cleanup,
229: Fcons (make_number (fd[0]), make_number (pid)));
230:
231:
232: if (XTYPE (buffer) == Lisp_Buffer)
233: Fset_buffer (buffer);
234:
235: immediate_quit = 1;
236: QUIT;
237:
238: {
239: register int nread;
240:
241: while ((nread = read (fd[0], buf, sizeof buf)) > 0)
242: {
243: immediate_quit = 0;
244: if (!NULL (buffer))
245: InsCStr (buf, nread);
246: if (!NULL (display) && INTERACTIVE)
247: DoDsp (1);
248: immediate_quit = 1;
249: QUIT;
250: }
251: }
252:
253: /* Wait for it to terminate, unless it already has. */
254: wait_for_termination (pid);
255:
256: immediate_quit = 0;
257:
258: SetBfp (old);
259:
260: unbind_to (count);
261:
262: return Qnil;
263: }
264:
265: DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
266: 3, MANY, 0,
267: "Send text from START to END to a process running PROGRAM.\n\
268: Delete the text if DELETE is non-nil.\n\
269: Put output in BUFFER, before point. nil => discard it, t => current buffer.\n\
270: Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
271: Remaining args are passed to PROGRAM at startup as command args.\n\
272: This function normally waits for the process to terminate;\n\
273: if you quit, the process is killed.")
274: (nargs, args)
275: int nargs;
276: register Lisp_Object *args;
277: {
278: register Lisp_Object filename_string, start, end;
279: char tempfile[20];
280:
281: strcpy (tempfile, "/tmp/emacsXXXXXX");
282: mktemp (tempfile);
283:
284: filename_string = build_string (tempfile);
285: start = args[0];
286: end = args[1];
287: Fwrite_region (start, end, filename_string, Qnil, Qlambda);
288:
289: if (!NULL (args[3]))
290: Fdelete_region (start, end);
291:
292: args[3] = filename_string;
293: Fcall_process (nargs - 2, args + 2);
294: unlink (tempfile);
295: return Qnil;
296: }
297:
298: /* This is the last thing run in a newly forked inferior
299: either synchronous or asynchronous.
300: Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
301: Initialize inferior's priority, pgrp, connected dir and environment.
302: then exec another program based on new_argv.
303:
304: This function may change environ for the superior process.
305: Therefore, the superior process must save and restore the value
306: of environ around the vfork and the call to this function.
307:
308: ENV is the environment */
309:
310: child_setup (in, out, err, new_argv, env)
311: int in, out, err;
312: register char **new_argv;
313: char **env;
314: {
315: register int pid = getpid();
316:
317: setpriority (PRIO_PROCESS, pid, 0);
318:
319: #ifdef subprocesses
320: /* Close Emacs's descriptors that this process should not have. */
321: close_process_descs ();
322: #endif
323:
324: /* Note that use of alloca is always safe here. It's obvious for systems
325: that do not have true vfork or that have true (stack) alloca.
326: If using vfork and C_ALLOCA it is safe because that changes
327: the superior's static variables as if the superior had done alloca
328: and will be cleaned up in the usual way. */
329:
330: if (XTYPE (bf_cur->directory) == Lisp_String)
331: {
332: register unsigned char *temp;
333: register int i;
334:
335: i = XSTRING (bf_cur->directory)->size;
336: temp = (unsigned char *) alloca (i + 2);
337: bcopy (XSTRING (bf_cur->directory)->data, temp, i);
338: if (temp[i - 1] != '/') temp[i++] = '/';
339: temp[i] = 0;
340: chdir (temp);
341: }
342:
343: #ifndef MAINTAIN_ENVIRONMENT
344: /* Set `env' to a vector of the strings in Vprocess_environment. */
345: {
346: register Lisp_Object tem;
347: register char **new_env;
348: register int new_length;
349:
350: new_length = 0;
351: for (tem = Vprocess_environment;
352: (XTYPE (tem) == Lisp_Cons
353: && XTYPE (XCONS (tem)->car) == Lisp_String);
354: tem = XCONS (tem)->cdr)
355: new_length++;
356:
357: /* new_length + 1 to include terminating 0 */
358: env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
359:
360: /* Copy the env strings into new_env. */
361: for (tem = Vprocess_environment;
362: (XTYPE (tem) == Lisp_Cons
363: && XTYPE (XCONS (tem)->car) == Lisp_String);
364: tem = XCONS (tem)->cdr)
365: *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
366: *new_env = 0;
367: }
368: #endif /* Not MAINTAIN_ENVIRONMENT */
369:
370: close (0);
371: close (1);
372: close (2);
373:
374: dup2 (in, 0);
375: dup2 (out, 1);
376: dup2 (err, 2);
377: close (in);
378: close (out);
379: close (err);
380:
381: #ifdef USG
382: #ifndef HAVE_PTYS
383: setpgrp (); /* No arguments but equivalent in this case */
384: #endif
385: #else
386: setpgrp (pid, pid);
387: #endif /* USG */
388: setpgrp_of_tty (pid);
389:
390: #ifdef vipc
391: something missing here;
392: #endif vipc
393:
394: /* execvp does not accept an environment arg so the only way
395: to pass this environment is to set environ. Our caller
396: is responsible for restoring the ambient value of environ. */
397: environ = env;
398: execvp (new_argv[0], new_argv);
399:
400: write (1, "Couldn't exec the program ", 26);
401: write (1, new_argv[0], strlen (new_argv[0]));
402: _exit (1);
403: }
404:
405: init_callproc ()
406: {
407: register char * sh;
408: extern char **environ;
409: register char **envp;
410: Lisp_Object execdir;
411:
412: /* Turn PATH_EXEC into a path. `==' is just a string which we know
413: will not be the name of an environment variable. */
414: Vexec_path = decode_env_path ("==", PATH_EXEC);
415: Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
416: Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
417:
418: execdir = Fdirectory_file_name (Vexec_directory);
419: if (access (XSTRING (execdir)->data, 0) < 0)
420: {
421: printf ("Warning: executable/documentation dir (%s) does not exist.\n",
422: XSTRING (Vexec_directory)->data);
423: sleep (2);
424: }
425:
426: sh = (char *) egetenv ("SHELL");
427: Vshell_file_name = build_string (sh ? sh : "/bin/sh");
428:
429: #ifndef MAINTAIN_ENVIRONMENT
430: /* The equivalent of this operation was done
431: in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
432: Vprocess_environment = Qnil;
433: #ifndef CANNOT_DUMP
434: if (initialized)
435: #endif
436: for (envp = environ; *envp; envp++)
437: Vprocess_environment = Fcons (build_string (*envp),
438: Vprocess_environment);
439: #endif /* MAINTAIN_ENVIRONMENT */
440: }
441:
442: syms_of_callproc ()
443: {
444: DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
445: "*File name to load inferior shells from.\n\
446: Initialized from the SHELL environment variable.");
447:
448: DEFVAR_LISP ("exec-path", &Vexec_path,
449: "*List of directories to search programs to run in subprocesses.\n\
450: Each element is a string (directory name) or nil (try default directory).");
451:
452: DEFVAR_LISP ("exec-directory", &Vexec_directory,
453: "Directory that holds programs that come with GNU Emacs,\n\
454: intended for Emacs to invoke.");
455:
456: #ifndef MAINTAIN_ENVIRONMENT
457: DEFVAR_LISP ("process-environment", &Vprocess_environment,
458: "List of strings to append to environment of subprocesses that are started.\n\
459: Each string should have the format ENVVARNAME=VALUE.");
460: #endif
461:
462: defsubr (&Scall_process);
463: defsubr (&Scall_process_region);
464: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.