comparison src/callproc.c @ 410:de805c49cfc1 r21-2-35

Import from CVS: tag r21-2-35
author cvs
date Mon, 13 Aug 2007 11:19:21 +0200
parents 501cfd01ee6d
children 697ef44129c6
comparison
equal deleted inserted replaced
409:301b9ebbdf3b 410:de805c49cfc1
39 #include "sysproc.h" 39 #include "sysproc.h"
40 #include "sysfile.h" /* Always include after sysproc.h */ 40 #include "sysfile.h" /* Always include after sysproc.h */
41 #include "syssignal.h" /* Always include before systty.h */ 41 #include "syssignal.h" /* Always include before systty.h */
42 #include "systty.h" 42 #include "systty.h"
43 43
44 #ifdef WINDOWSNT 44 #ifdef WIN32_NATIVE
45 #define _P_NOWAIT 1 /* from process.h */ 45 #define _P_NOWAIT 1 /* from process.h */
46 #include "nt.h" 46 #include "nt.h"
47 #endif 47 #endif
48 48
49 #ifdef DOS_NT 49 #ifdef WIN32_NATIVE
50 /* When we are starting external processes we need to know whether they 50 /* When we are starting external processes we need to know whether they
51 take binary input (no conversion) or text input (\n is converted to 51 take binary input (no conversion) or text input (\n is converted to
52 \r\n). Similarly for output: if newlines are written as \r\n then it's 52 \r\n). Similarly for output: if newlines are written as \r\n then it's
53 text process output, otherwise it's binary. */ 53 text process output, otherwise it's binary. */
54 Lisp_Object Vbinary_process_input; 54 Lisp_Object Vbinary_process_input;
55 Lisp_Object Vbinary_process_output; 55 Lisp_Object Vbinary_process_output;
56 #endif /* DOS_NT */ 56 #endif /* WIN32_NATIVE */
57 57
58 Lisp_Object Vshell_file_name; 58 Lisp_Object Vshell_file_name;
59 59
60 /* The environment to pass to all subprocesses when they are started. 60 /* The environment to pass to all subprocesses when they are started.
61 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... ) 61 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
72 /* If synch_process_death is zero, 72 /* If synch_process_death is zero,
73 this is exit code of synchronous subprocess. */ 73 this is exit code of synchronous subprocess. */
74 int synch_process_retcode; 74 int synch_process_retcode;
75 75
76 /* Clean up when exiting Fcall_process_internal. 76 /* Clean up when exiting Fcall_process_internal.
77 On MSDOS, delete the temporary file on any kind of termination. 77 On Windows, delete the temporary file on any kind of termination.
78 On Unix, kill the process and any children on termination by signal. */ 78 On Unix, kill the process and any children on termination by signal. */
79 79
80 /* Nonzero if this is termination due to exit. */ 80 /* Nonzero if this is termination due to exit. */
81 static int call_process_exited; 81 static int call_process_exited;
82 82
111 111
112 record_unwind_protect (call_process_kill, fdpid); 112 record_unwind_protect (call_process_kill, fdpid);
113 /* #### "c-G" -- need non-consing Single-key-description */ 113 /* #### "c-G" -- need non-consing Single-key-description */
114 message ("Waiting for process to die...(type C-g again to kill it instantly)"); 114 message ("Waiting for process to die...(type C-g again to kill it instantly)");
115 115
116 #ifdef WINDOWSNT 116 #ifdef WIN32_NATIVE
117 { 117 {
118 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); 118 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
119 if (pHandle == NULL) 119 if (pHandle == NULL)
120 warn_when_safe (Qprocess, Qwarning, 120 warn_when_safe (Qprocess, Qwarning,
121 "cannot open process (PID %d) for cleanup", pid); 121 "cannot open process (PID %d) for cleanup", pid);
178 { 178 {
179 /* This function can GC */ 179 /* This function can GC */
180 Lisp_Object infile, buffer, current_dir, display, path; 180 Lisp_Object infile, buffer, current_dir, display, path;
181 int fd[2]; 181 int fd[2];
182 int filefd; 182 int filefd;
183 #ifdef WINDOWSNT 183 #ifdef WIN32_NATIVE
184 HANDLE pHandle; 184 HANDLE pHandle;
185 #endif 185 #endif
186 int pid; 186 int pid;
187 char buf[16384]; 187 char buf[16384];
188 char *bufptr = buf; 188 char *bufptr = buf;
347 if (NILP (error_file)) 347 if (NILP (error_file))
348 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); 348 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
349 else if (STRINGP (error_file)) 349 else if (STRINGP (error_file))
350 { 350 {
351 fd_error = open ((const char *) XSTRING_DATA (error_file), 351 fd_error = open ((const char *) XSTRING_DATA (error_file),
352 #ifdef DOS_NT 352 #ifdef WIN32_NATIVE
353 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, 353 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
354 S_IREAD | S_IWRITE 354 S_IREAD | S_IWRITE
355 #else /* not DOS_NT */ 355 #else /* not WIN32_NATIVE */
356 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, 356 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
357 CREAT_MODE 357 CREAT_MODE
358 #endif /* not DOS_NT */ 358 #endif /* not WIN32_NATIVE */
359 ); 359 );
360 } 360 }
361 361
362 if (fd_error < 0) 362 if (fd_error < 0)
363 { 363 {
367 close (fd1); 367 close (fd1);
368 report_file_error ("Cannot open", Fcons(error_file, Qnil)); 368 report_file_error ("Cannot open", Fcons(error_file, Qnil));
369 } 369 }
370 370
371 fork_error = Qnil; 371 fork_error = Qnil;
372 #ifdef WINDOWSNT 372 #ifdef WIN32_NATIVE
373 pid = child_setup (filefd, fd1, fd_error, new_argv, 373 pid = child_setup (filefd, fd1, fd_error, new_argv,
374 (char *) XSTRING_DATA (current_dir)); 374 (char *) XSTRING_DATA (current_dir));
375 if (!INTP (buffer)) 375 if (!INTP (buffer))
376 { 376 {
377 /* OpenProcess() as soon after child_setup as possible. It's too 377 /* OpenProcess() as soon after child_setup as possible. It's too
387 #endif 387 #endif
388 } 388 }
389 /* Close STDERR into the parent process. We no longer need it. */ 389 /* Close STDERR into the parent process. We no longer need it. */
390 if (fd_error >= 0) 390 if (fd_error >= 0)
391 close (fd_error); 391 close (fd_error);
392 #else /* not WINDOWSNT */ 392 #else /* not WIN32_NATIVE */
393 pid = fork (); 393 pid = fork ();
394 394
395 if (pid == 0) 395 if (pid == 0)
396 { 396 {
397 if (fd[0] >= 0) 397 if (fd[0] >= 0)
408 (char *) XSTRING_DATA (current_dir)); 408 (char *) XSTRING_DATA (current_dir));
409 } 409 }
410 if (fd_error >= 0) 410 if (fd_error >= 0)
411 close (fd_error); 411 close (fd_error);
412 412
413 #endif /* not WINDOWSNT */ 413 #endif /* not WIN32_NATIVE */
414 414
415 environ = save_environ; 415 environ = save_environ;
416 416
417 /* Close most of our fd's, but not fd[0] 417 /* Close most of our fd's, but not fd[0]
418 since we will use that to read input from. */ 418 since we will use that to read input from. */
422 } 422 }
423 423
424 if (!NILP (fork_error)) 424 if (!NILP (fork_error))
425 signal_error (Qfile_error, fork_error); 425 signal_error (Qfile_error, fork_error);
426 426
427 #ifndef WINDOWSNT 427 #ifndef WIN32_NATIVE
428 if (pid < 0) 428 if (pid < 0)
429 { 429 {
430 if (fd[0] >= 0) 430 if (fd[0] >= 0)
431 close (fd[0]); 431 close (fd[0]);
432 report_file_error ("Doing fork", Qnil); 432 report_file_error ("Doing fork", Qnil);
500 /* Now NREAD is the total amount of data in the buffer. */ 500 /* Now NREAD is the total amount of data in the buffer. */
501 if (nread == 0) 501 if (nread == 0)
502 break; 502 break;
503 503
504 #if 0 504 #if 0
505 #ifdef DOS_NT 505 #ifdef WIN32_NATIVE
506 /* Until we pull out of MULE things like 506 /* Until we pull out of MULE things like
507 make_decoding_input_stream(), we do the following which is 507 make_decoding_input_stream(), we do the following which is
508 less elegant. --marcpa */ 508 less elegant. --marcpa */
509 /* We did. -- kkm */ 509 /* We did. -- kkm */
510 { 510 {
540 Lstream_close (XLSTREAM (instream)); 540 Lstream_close (XLSTREAM (instream));
541 NUNGCPRO; 541 NUNGCPRO;
542 542
543 QUIT; 543 QUIT;
544 /* Wait for it to terminate, unless it already has. */ 544 /* Wait for it to terminate, unless it already has. */
545 #ifdef WINDOWSNT 545 #ifdef WIN32_NATIVE
546 wait_for_termination (pHandle); 546 wait_for_termination (pHandle);
547 #else 547 #else
548 wait_for_termination (pid); 548 wait_for_termination (pid);
549 #endif 549 #endif
550 550
600 CURRENT_DIR is an elisp string giving the path of the current 600 CURRENT_DIR is an elisp string giving the path of the current
601 directory the subprocess should have. Since we can't really signal 601 directory the subprocess should have. Since we can't really signal
602 a decent error from within the child, this should be verified as an 602 a decent error from within the child, this should be verified as an
603 executable directory by the parent. */ 603 executable directory by the parent. */
604 604
605 #ifdef WINDOWSNT 605 #ifdef WIN32_NATIVE
606 int 606 int
607 #else 607 #else
608 void 608 void
609 #endif 609 #endif
610 child_setup (int in, int out, int err, char **new_argv, 610 child_setup (int in, int out, int err, char **new_argv,
611 const char *current_dir) 611 const char *current_dir)
612 { 612 {
613 char **env; 613 char **env;
614 char *pwd; 614 char *pwd;
615 #ifdef WINDOWSNT 615 #ifdef WIN32_NATIVE
616 int cpid; 616 int cpid;
617 HANDLE handles[4]; 617 HANDLE handles[4];
618 #endif /* WINDOWSNT */ 618 #endif /* WIN32_NATIVE */
619 619
620 #ifdef SET_EMACS_PRIORITY 620 #ifdef SET_EMACS_PRIORITY
621 if (emacs_priority != 0) 621 if (emacs_priority != 0)
622 nice (- emacs_priority); 622 nice (- emacs_priority);
623 #endif 623 #endif
624 624
625 #if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT) 625 /* Under Windows, we are not in a child process at all, so we should
626 not close handles inherited from the parent -- we are the parent
627 and doing so will screw up all manner of things! Similarly, most
628 of the rest of the cleanup done in this function is not done
629 under Windows.
630
631 #### This entire child_setup() function is an utter and complete
632 piece of shit. I would rewrite it, at the very least splitting
633 out the Windows and non-Windows stuff into two completely
634 different functions; but instead I'm trying to make it go away
635 entirely, using the Lisp definition in process.el. What's left
636 is to fix up the routines in event-msw.c (and in event-Xt.c and
637 event-tty.c) to allow for stream devices to be handled correctly.
638 There isn't much to do, in fact, and I'll fix it shortly. That
639 way, the Lisp definition can be used non-interactively too. */
640 #if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE)
626 /* Close Emacs's descriptors that this process should not have. */ 641 /* Close Emacs's descriptors that this process should not have. */
627 close_process_descs (); 642 close_process_descs ();
628 #endif /* not NO_SUBPROCESSES */ 643 #endif /* not NO_SUBPROCESSES */
644 #ifndef WIN32_NATIVE
629 close_load_descs (); 645 close_load_descs ();
646 #endif
630 647
631 /* Note that use of alloca is always safe here. It's obvious for systems 648 /* Note that use of alloca is always safe here. It's obvious for systems
632 that do not have true vfork or that have true (stack) alloca. 649 that do not have true vfork or that have true (stack) alloca.
633 If using vfork and C_ALLOCA it is safe because that changes 650 If using vfork and C_ALLOCA it is safe because that changes
634 the superior's static variables as if the superior had done alloca 651 the superior's static variables as if the superior had done alloca
719 duplicate: ; 736 duplicate: ;
720 } 737 }
721 *new_env = 0; 738 *new_env = 0;
722 } 739 }
723 740
724 #ifdef WINDOWSNT 741 #ifdef WIN32_NATIVE
725 prepare_standard_handles (in, out, err, handles); 742 prepare_standard_handles (in, out, err, handles);
726 set_process_dir (current_dir); 743 set_process_dir (current_dir);
727 #else /* not WINDOWSNT */ 744 #else /* not WIN32_NATIVE */
728 /* Make sure that in, out, and err are not actually already in 745 /* Make sure that in, out, and err are not actually already in
729 descriptors zero, one, or two; this could happen if Emacs is 746 descriptors zero, one, or two; this could happen if Emacs is
730 started with its standard in, out, or error closed, as might 747 started with its standard in, out, or error closed, as might
731 happen under X. */ 748 happen under X. */
732 in = relocate_fd (in, 3); 749 in = relocate_fd (in, 3);
753 { 770 {
754 int fd; 771 int fd;
755 for (fd=3; fd<=64; fd++) 772 for (fd=3; fd<=64; fd++)
756 close (fd); 773 close (fd);
757 } 774 }
758 #endif /* not WINDOWSNT */ 775 #endif /* not WIN32_NATIVE */
759 776
760 #ifdef vipc 777 #ifdef vipc
761 something missing here; 778 something missing here;
762 #endif /* vipc */ 779 #endif /* vipc */
763 780
764 #ifdef WINDOWSNT 781 #ifdef WIN32_NATIVE
765 /* Spawn the child. (See ntproc.c:Spawnve). */ 782 /* Spawn the child. (See ntproc.c:Spawnve). */
766 cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, 783 cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv,
767 (const char* const*)env); 784 (const char* const*)env);
768 if (cpid == -1) 785 if (cpid == -1)
769 /* An error occurred while trying to spawn the process. */ 786 /* An error occurred while trying to spawn the process. */
770 report_file_error ("Spawning child process", Qnil); 787 report_file_error ("Spawning child process", Qnil);
771 reset_standard_handles (in, out, err, handles); 788 reset_standard_handles (in, out, err, handles);
772 return cpid; 789 return cpid;
773 #else /* not WINDOWSNT */ 790 #else /* not WIN32_NATIVE */
774 /* execvp does not accept an environment arg so the only way 791 /* execvp does not accept an environment arg so the only way
775 to pass this environment is to set environ. Our caller 792 to pass this environment is to set environ. Our caller
776 is responsible for restoring the ambient value of environ. */ 793 is responsible for restoring the ambient value of environ. */
777 environ = env; 794 environ = env;
778 execvp (new_argv[0], new_argv); 795 execvp (new_argv[0], new_argv);
779 796
780 stdout_out ("Can't exec program %s\n", new_argv[0]); 797 stdout_out ("Can't exec program %s\n", new_argv[0]);
781 _exit (1); 798 _exit (1);
782 #endif /* not WINDOWSNT */ 799 #endif /* not WIN32_NATIVE */
783 } 800 }
784 801
785 static int 802 static int
786 getenv_internal (const Bufbyte *var, 803 getenv_internal (const Bufbyte *var,
787 Bytecount varlen, 804 Bytecount varlen,
795 Lisp_Object entry = XCAR (scan); 812 Lisp_Object entry = XCAR (scan);
796 813
797 if (STRINGP (entry) 814 if (STRINGP (entry)
798 && XSTRING_LENGTH (entry) > varlen 815 && XSTRING_LENGTH (entry) > varlen
799 && XSTRING_BYTE (entry, varlen) == '=' 816 && XSTRING_BYTE (entry, varlen) == '='
800 #ifdef WINDOWSNT 817 #ifdef WIN32_NATIVE
801 /* NT environment variables are case insensitive. */ 818 /* NT environment variables are case insensitive. */
802 && ! memicmp (XSTRING_DATA (entry), var, varlen) 819 && ! memicmp (XSTRING_DATA (entry), var, varlen)
803 #else /* not WINDOWSNT */ 820 #else /* not WIN32_NATIVE */
804 && ! memcmp (XSTRING_DATA (entry), var, varlen) 821 && ! memcmp (XSTRING_DATA (entry), var, varlen)
805 #endif /* not WINDOWSNT */ 822 #endif /* not WIN32_NATIVE */
806 ) 823 )
807 { 824 {
808 *value = XSTRING_DATA (entry) + (varlen + 1); 825 *value = XSTRING_DATA (entry) + (varlen + 1);
809 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); 826 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
810 return 1; 827 return 1;
873 Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); 890 Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment);
874 } 891 }
875 892
876 { 893 {
877 /* Initialize shell-file-name from environment variables or best guess. */ 894 /* Initialize shell-file-name from environment variables or best guess. */
878 #ifdef WINDOWSNT 895 #ifdef WIN32_NATIVE
879 const char *shell = egetenv ("COMSPEC"); 896 const char *shell = egetenv ("COMSPEC");
880 if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; 897 if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
881 #else /* not WINDOWSNT */ 898 #else /* not WIN32_NATIVE */
882 const char *shell = egetenv ("SHELL"); 899 const char *shell = egetenv ("SHELL");
883 if (!shell) shell = "/bin/sh"; 900 if (!shell) shell = "/bin/sh";
884 #endif 901 #endif
885 902
886 Vshell_file_name = build_string (shell); 903 Vshell_file_name = build_string (shell);
912 929
913 void 930 void
914 vars_of_callproc (void) 931 vars_of_callproc (void)
915 { 932 {
916 /* This function can GC */ 933 /* This function can GC */
917 #ifdef DOS_NT 934 #ifdef WIN32_NATIVE
918 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* 935 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
919 *If non-nil then new subprocesses are assumed to take binary input. 936 *If non-nil then new subprocesses are assumed to take binary input.
920 */ ); 937 */ );
921 Vbinary_process_input = Qnil; 938 Vbinary_process_input = Qnil;
922 939
923 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /* 940 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
924 *If non-nil then new subprocesses are assumed to produce binary output. 941 *If non-nil then new subprocesses are assumed to produce binary output.
925 */ ); 942 */ );
926 Vbinary_process_output = Qnil; 943 Vbinary_process_output = Qnil;
927 #endif /* DOS_NT */ 944 #endif /* WIN32_NATIVE */
928 945
929 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* 946 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
930 *File name to load inferior shells from. 947 *File name to load inferior shells from.
931 Initialized from the SHELL environment variable. 948 Initialized from the SHELL environment variable.
932 */ ); 949 */ );