Return to callproc.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/callproc.c, revision 1.1

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.