1 /* Asynchronous subprocess control 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 #include <signal.h> 22 23 #include "config.h" 24 25 #ifdef subprocesses 26 /* The entire file is within this conditional */ 27 28 #include <stdio.h> 29 #include <errno.h> 30 #include <setjmp.h> 31 #include <sys/types.h> /* some typedefs are used in sys/file.h */ 32 #include <sys/file.h> 33 #include <sys/stat.h> 34 35 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */ 36 #include <sys/socket.h> 37 #include <netdb.h> 38 #include <netinet/in.h> 39 #endif /* HAVE_SOCKETS */ 40 41 #if defined(BSD) || defined(STRIDE) 42 #include <sys/ioctl.h> 43 #if !defined (O_NDELAY) && defined (HAVE_PTYS) 44 #include <fcntl.h> 45 #endif /* HAVE_PTYS and no O_NDELAY */ 46 #endif /* BSD or STRIDE */ 47 #ifdef USG 48 #include <termio.h> 49 #include <fcntl.h> 50 #endif /* USG */ 51 52 #ifdef NEED_BSDTTY 53 #include <sys/bsdtty.h> 54 #endif 55 56 #ifdef HPUX 57 #undef TIOCGPGRP 58 #endif 59 60 #ifdef IRIS 61 #include <sys/sysmacros.h> /* for "minor" */ 62 #include <sys/time.h> 63 #else 64 #ifdef UNIPLUS 65 #include <sys/time.h> 66 67 #else /* not IRIS, not UNIPLUS */ 68 #ifdef HAVE_TIMEVAL 69 /* _h_BSDTYPES is checked because on ISC unix, socket.h includes 70 both time.h and sys/time.h, and the latter file is protected 71 from repeated inclusion. */ 72 #if defined(USG) && !defined(AIX) && !defined(_h_BSDTYPES) && !defined(USG_SYS_TIME) 73 #include <time.h> 74 #else /* AIX or USG_SYS_TIME, or not USG */ 75 #include <sys/time.h> 76 #endif /* AIX or USG_SYS_TIME, or not USG */ 77 #endif /* HAVE_TIMEVAL */ 78 79 #endif /* not UNIPLUS */ 80 #endif /* not IRIS */ 81 82 #if defined (HPUX) && defined (HAVE_PTYS) 83 #include <sys/ptyio.h> 84 #endif 85 86 #ifdef AIX 87 #include <sys/pty.h> 88 #include <unistd.h> 89 #endif /* AIX */ 90 91 #ifdef SYSV_PTYS 92 #include <sys/tty.h> 93 #include <sys/pty.h> 94 #endif 95 96 #undef NULL 97 #include "lisp.h" 98 #include "window.h" 99 #include "buffer.h" 100 #include "process.h" 101 #include "termhooks.h" 102 #include "termopts.h" 103 #include "commands.h" 104 105 Lisp_Object Qrun, Qstop, Qsignal, Qexit, Qopen, Qclosed; 106 107 /* a process object is a network connection when its childp field is neither 108 Qt nor Qnil but is instead a string (name of foreign host we 109 are connected to + name of port we are connected to) */ 110 111 #ifdef HAVE_SOCKETS 112 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String) 113 #else 114 #define NETCONN_P(p) 0 115 #endif /* HAVE_SOCKETS */ 116 117 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals 118 testing SIGCHLD. */ 119 120 #if !defined (SIGCHLD) && defined (SIGCLD) 121 #define SIGCHLD SIGCLD 122 #endif /* SIGCLD */ 123 124 /* Define the structure that the wait system call stores. 125 On many systems, there is a structure defined for this. 126 But on vanilla-ish USG systems there is not. */ 127 128 #ifndef WAITTYPE 129 #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER) 130 #define WAITTYPE int 131 #define WIFSTOPPED(w) ((w&0377) == 0177) 132 #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0) 133 #define WIFEXITED(w) ((w&0377) == 0) 134 #define WRETCODE(w) (w >> 8) 135 #define WSTOPSIG(w) (w >> 8) 136 #define WTERMSIG(w) (w & 0377) 137 #ifndef WCOREDUMP 138 #define WCOREDUMP(w) ((w&0200) != 0) 139 #endif 140 #else 141 #ifdef BSD4_1 142 #include <wait.h> 143 #else 144 #include <sys/wait.h> 145 #endif /* not BSD 4.1 */ 146 147 #define WAITTYPE union wait 148 #ifndef WRETCODE 149 #define WRETCODE(w) w.w_retcode 150 #endif 151 #ifndef WCOREDUMP 152 #define WCOREDUMP(w) w.w_coredump 153 #endif 154 155 #ifdef HPUX 156 /* HPUX version 7 has broken definitions of these. */ 157 #undef WTERMSIG 158 #undef WSTOPSIG 159 #undef WIFSTOPPED 160 #undef WIFSIGNALED 161 #undef WIFEXITED 162 #endif 163 164 #ifndef WTERMSIG 165 #define WTERMSIG(w) w.w_termsig 166 #endif 167 #ifndef WSTOPSIG 168 #define WSTOPSIG(w) w.w_stopsig 169 #endif 170 #ifndef WIFSTOPPED 171 #define WIFSTOPPED(w) (WTERMSIG (w) == 0177) 172 #endif 173 #ifndef WIFSIGNALED 174 #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0) 175 #endif 176 #ifndef WIFEXITED 177 #define WIFEXITED(w) (WTERMSIG (w) == 0) 178 #endif 179 #endif /* BSD or UNIPLUS or STRIDE */ 180 #endif /* no WAITTYPE */ 181 182 #ifndef BSD4_4 183 extern errno; 184 extern sys_nerr; 185 extern char *sys_errlist[]; 186 #endif 187 188 #ifndef BSD4_1 189 #ifndef BSD4_4 190 extern char *sys_siglist[]; 191 #endif 192 #else 193 char *sys_siglist[] = 194 { 195 "bum signal!!", 196 "hangup", 197 "interrupt", 198 "quit", 199 "illegal instruction", 200 "trace trap", 201 "iot instruction", 202 "emt instruction", 203 "floating point exception", 204 "kill", 205 "bus error", 206 "segmentation violation", 207 "bad argument to system call", 208 "write on a pipe with no one to read it", 209 "alarm clock", 210 "software termination signal from kill", 211 "status signal", 212 "sendable stop signal not from tty", 213 "stop signal from tty", 214 "continue a stopped process", 215 "child status has changed", 216 "background read attempted from control tty", 217 "background write attempted from control tty", 218 "input record available at control tty", 219 "exceeded CPU time limit", 220 "exceeded file size limit" 221 }; 222 #endif 223 224 #ifdef vipc 225 226 #include "vipc.h" 227 extern int comm_server; 228 extern int net_listen_address; 229 #endif /* vipc */ 230 231 /* t means use pty, nil means use a pipe, 232 maybe other values to come. */ 233 Lisp_Object Vprocess_connection_type; 234 235 #ifdef SKTPAIR 236 #ifndef HAVE_SOCKETS 237 #include <sys/socket.h> 238 #endif 239 #endif /* SKTPAIR */ 240 241 /* Number of events of change of status of a process. */ 242 int process_tick; 243 244 /* Number of events for which the user or sentinel has been notified. */ 245 int update_tick; 246 247 int delete_exited_processes; 248 249 #ifdef FD_SET 250 /* We could get this from param.h, but better not to depend on finding that. 251 And better not to risk that it might define other symbols used in this 252 file. */ 253 #define MAXDESC 64 254 #define SELECT_TYPE fd_set 255 #else /* no FD_SET */ 256 #define MAXDESC 32 257 #define SELECT_TYPE int 258 259 /* Define the macros to access a single-int bitmap of descriptors. */ 260 #define FD_SET(n, p) (*(p) |= (1 << (n))) 261 #define FD_CLR(n, p) (*(p) &= ~(1 << (n))) 262 #define FD_ISSET(n, p) (*(p) & (1 << (n))) 263 #define FD_ZERO(p) (*(p) = 0) 264 #endif /* no FD_SET */ 265 266 /* Mask of bits indicating the descriptors that we wait for input on */ 267 268 SELECT_TYPE input_wait_mask; 269 270 /* Indexed by descriptor, gives the process (if any) for that descriptor */ 271 Lisp_Object chan_process[MAXDESC]; 272 273 /* Alist of elements (NAME . PROCESS) */ 274 Lisp_Object Vprocess_alist; 275 276 Lisp_Object Qprocessp; 277 278 Lisp_Object get_process (); 279 280 /* Buffered-ahead input char from process, indexed by channel. 281 -1 means empty (no char is buffered). 282 Used on sys V where the only way to tell if there is any 283 output from the process is to read at least one char. 284 Always -1 on systems that support FIONREAD. */ 285 286 int proc_buffered_char[MAXDESC]; 287 288 /* These variables hold the filter about to be run, and its args, 289 between read_process_output and run_filter. 290 Also used in exec_sentinel for sentinels. */ 291 Lisp_Object this_filter; 292 Lisp_Object filter_process, filter_string; 293 294 /* Compute the Lisp form of the process status, p->status, 295 from the numeric status that was returned by `wait'. */ 296 297 update_status (p) 298 struct Lisp_Process *p; 299 { 300 union { int i; WAITTYPE wt; } u; 301 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16); 302 p->status = status_convert (u.wt); 303 p->raw_status_low = Qnil; 304 p->raw_status_high = Qnil; 305 } 306 307 /* Convert a process status word in Unix format 308 to the list that we use internally. */ 309 310 Lisp_Object 311 status_convert (w) 312 WAITTYPE w; 313 { 314 if (WIFSTOPPED (w)) 315 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil)); 316 else if (WIFEXITED (w)) 317 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)), 318 WCOREDUMP (w) ? Qt : Qnil)); 319 else if (WIFSIGNALED (w)) 320 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)), 321 WCOREDUMP (w) ? Qt : Qnil)); 322 else 323 return Qrun; 324 } 325 326 /* Given a status-list, extract the three pieces of information 327 and store them individually through the three pointers. */ 328 329 void 330 decode_status (l, symbol, code, coredump) 331 Lisp_Object l; 332 Lisp_Object *symbol; 333 int *code; 334 int *coredump; 335 { 336 Lisp_Object tem; 337 338 if (XTYPE (l) == Lisp_Symbol) 339 { 340 *symbol = l; 341 *code = 0; 342 *coredump = 0; 343 } 344 else 345 { 346 *symbol = XCONS (l)->car; 347 tem = XCONS (l)->cdr; 348 *code = XFASTINT (XCONS (tem)->car); 349 tem = XFASTINT (XCONS (tem)->cdr); 350 *coredump = !NULL (tem); 351 } 352 } 353 354 /* Return a string describing a process status list. */ 355 356 Lisp_Object 357 status_message (status) 358 Lisp_Object status; 359 { 360 Lisp_Object symbol; 361 int code, coredump; 362 Lisp_Object string, string2; 363 364 decode_status (status, &symbol, &code, &coredump); 365 366 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) 367 { 368 string = build_string (code < NSIG ? sys_siglist[code] : "unknown"); 369 string2 = build_string (coredump ? " (core dumped)\n" : "\n"); 370 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]); 371 return concat2 (string, string2); 372 } 373 else if (EQ (symbol, Qexit)) 374 { 375 if (code == 0) 376 return build_string ("finished\n"); 377 string = Fint_to_string (make_number (code)); 378 string2 = build_string (coredump ? " (core dumped)\n" : "\n"); 379 return concat2 (build_string ("exited abnormally with code "), 380 concat2 (string, string2)); 381 } 382 else 383 return Fcopy_sequence (Fsymbol_name (symbol)); 384 } 385 386 #ifdef HAVE_PTYS 387 388 /* Open an available pty, returning a file descriptor. 389 Return -1 on failure. 390 The file name of the terminal corresponding to the pty 391 is left in the variable pty_name. */ 392 393 char pty_name[24]; 394 395 int 396 allocate_pty () 397 { 398 struct stat stb; 399 register c, i; 400 int fd; 401 402 #ifdef PTY_ITERATION 403 PTY_ITERATION 404 #else 405 for (c = FIRST_PTY_LETTER; c <= 'z'; c++) 406 for (i = 0; i < 16; i++) 407 #endif 408 { 409 #ifdef PTY_NAME_SPRINTF 410 PTY_NAME_SPRINTF 411 #else 412 #ifdef HPUX 413 sprintf (pty_name, "/dev/ptym/pty%c%x", c, i); 414 #else 415 #ifdef RTU 416 sprintf (pty_name, "/dev/pty%x", i); 417 #else 418 sprintf (pty_name, "/dev/pty%c%x", c, i); 419 #endif /* not RTU */ 420 #endif /* not HPUX */ 421 #endif /* no PTY_NAME_SPRINTF */ 422 423 #ifndef IRIS 424 if (stat (pty_name, &stb) < 0) 425 return -1; 426 #ifdef O_NONBLOCK 427 fd = open (pty_name, O_RDWR | O_NONBLOCK, 0); 428 #else 429 fd = open (pty_name, O_RDWR | O_NDELAY, 0); 430 #endif 431 #else /* Unusual IRIS code */ 432 fd = open ("/dev/ptc", O_RDWR | O_NDELAY, 0); 433 if (fd < 0) 434 return -1; 435 if (fstat (fd, &stb) < 0) 436 return -1; 437 #endif /* IRIS */ 438 439 if (fd >= 0) 440 { 441 /* check to make certain that both sides are available 442 this avoids a nasty yet stupid bug in rlogins */ 443 #ifdef PTY_TTY_NAME_SPRINTF 444 PTY_TTY_NAME_SPRINTF 445 #else 446 /* In version 19, make these special cases use the macro above. */ 447 #ifdef HPUX 448 sprintf (pty_name, "/dev/pty/tty%c%x", c, i); 449 #else 450 #ifdef RTU 451 sprintf (pty_name, "/dev/ttyp%x", i); 452 #else 453 #ifdef IRIS 454 sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev)); 455 #else 456 sprintf (pty_name, "/dev/tty%c%x", c, i); 457 #endif /* not IRIS */ 458 #endif /* not RTU */ 459 #endif /* not HPUX */ 460 #endif /* no PTY_TTY_NAME_SPRINTF */ 461 #ifndef UNIPLUS 462 if (access (pty_name, 6) != 0) 463 { 464 close (fd); 465 #ifndef IRIS 466 continue; 467 #else 468 return -1; 469 #endif /* IRIS */ 470 } 471 #endif /* not UNIPLUS */ 472 setup_pty (fd); 473 return fd; 474 } 475 } 476 return -1; 477 } 478 #endif /* HAVE_PTYS */ 479 480 Lisp_Object 481 make_process (name) 482 Lisp_Object name; 483 { 484 register Lisp_Object val, tem, name1; 485 register struct Lisp_Process *p; 486 char suffix[10]; 487 register int i; 488 489 /* size of process structure includes the vector header, 490 so deduct for that. But struct Lisp_Vector includes the first 491 element, thus deducts too much, so add it back. */ 492 val = Fmake_vector (make_number ((sizeof (struct Lisp_Process) 493 - sizeof (struct Lisp_Vector) 494 + sizeof (Lisp_Object)) 495 / sizeof (Lisp_Object)), 496 Qnil); 497 XSETTYPE (val, Lisp_Process); 498 499 p = XPROCESS (val); 500 XFASTINT (p->infd) = 0; 501 XFASTINT (p->outfd) = 0; 502 XFASTINT (p->pid) = 0; 503 XFASTINT (p->tick) = 0; 504 XFASTINT (p->update_tick) = 0; 505 p->raw_status_low = Qnil; 506 p->raw_status_high = Qnil; 507 p->status = Qrun; 508 p->mark = Fmake_marker (); 509 510 /* If name is already in use, modify it until it is unused. */ 511 512 name1 = name; 513 for (i = 1; ; i++) 514 { 515 tem = Fget_process (name1); 516 if (NULL (tem)) break; 517 sprintf (suffix, "<%d>", i); 518 name1 = concat2 (name, build_string (suffix)); 519 } 520 name = name1; 521 p->name = name; 522 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); 523 return val; 524 } 525 526 remove_process (proc) 527 register Lisp_Object proc; 528 { 529 register Lisp_Object pair; 530 531 pair = Frassq (proc, Vprocess_alist); 532 Vprocess_alist = Fdelq (pair, Vprocess_alist); 533 Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); 534 535 deactivate_process (proc); 536 } 537 538 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, 539 "Return t if OBJECT is a process.") 540 (obj) 541 Lisp_Object obj; 542 { 543 return XTYPE (obj) == Lisp_Process ? Qt : Qnil; 544 } 545 546 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, 547 "Return the process named NAME, or nil if there is none.") 548 (name) 549 register Lisp_Object name; 550 { 551 if (XTYPE (name) == Lisp_Process) 552 return name; 553 CHECK_STRING (name, 0); 554 return Fcdr (Fassoc (name, Vprocess_alist)); 555 } 556 557 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, 558 "Return the (or, a) process associated with BUFFER.\n\ 559 BUFFER may be a buffer or the name of one.") 560 (name) 561 register Lisp_Object name; 562 { 563 register Lisp_Object buf, tail, proc; 564 565 if (NULL (name)) return Qnil; 566 buf = Fget_buffer (name); 567 if (NULL (buf)) return Qnil; 568 569 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail)) 570 { 571 proc = Fcdr (Fcar (tail)); 572 if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf)) 573 return proc; 574 } 575 return Qnil; 576 } 577 578 /* This is how commands for the user decode process arguments */ 579 580 Lisp_Object 581 get_process (name) 582 register Lisp_Object name; 583 { 584 register Lisp_Object proc; 585 if (NULL (name)) 586 proc = Fget_buffer_process (Fcurrent_buffer ()); 587 else 588 { 589 proc = Fget_process (name); 590 if (NULL (proc)) 591 proc = Fget_buffer_process (Fget_buffer (name)); 592 } 593 594 if (!NULL (proc)) 595 return proc; 596 597 if (NULL (name)) 598 error ("Current buffer has no process"); 599 else 600 error ("Process %s does not exist", XSTRING (name)->data); 601 /* NOTREACHED */ 602 } 603 604 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, 605 "Delete PROCESS: kill it and forget about it immediately.\n\ 606 PROCESS may be a process or the name of one, or a buffer name.") 607 (proc) 608 register Lisp_Object proc; 609 { 610 proc = get_process (proc); 611 XPROCESS (proc)->raw_status_low = Qnil; 612 XPROCESS (proc)->raw_status_high = Qnil; 613 if (NETCONN_P (proc)) 614 { 615 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); 616 XSETINT (XPROCESS (proc)->tick, ++process_tick); 617 } 618 else if (XFASTINT (XPROCESS (proc)->infd)) 619 { 620 Fkill_process (proc, Qnil); 621 /* Do this now, since remove_process will make sigchld_handler do nothing. */ 622 XPROCESS (proc)->status 623 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); 624 XSETINT (XPROCESS (proc)->tick, ++process_tick); 625 status_notify (); 626 } 627 remove_process (proc); 628 return Qnil; 629 } 630 631 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, 632 "Return the status of PROCESS: a symbol, one of these:\n\ 633 run -- for a process that is running.\n\ 634 stop -- for a process stopped but continuable.\n\ 635 exit -- for a process that has exited.\n\ 636 signal -- for a process that has got a fatal signal.\n\ 637 open -- for a network stream connection that is open.\n\ 638 closed -- for a network stream connection that is closed.\n\ 639 nil -- if arg is a process name and no such process exists.") 640 /* command -- for a command channel opened to Emacs by another process.\n\ 641 external -- for an i/o channel opened to Emacs by another process.\n\ */ 642 (proc) 643 register Lisp_Object proc; 644 { 645 register struct Lisp_Process *p; 646 proc = Fget_process (proc); 647 if (NULL (proc)) 648 return proc; 649 p = XPROCESS (proc); 650 if (!NULL (p->raw_status_low)) 651 update_status (p); 652 if (XTYPE (p->status) == Lisp_Cons) 653 return XCONS (p->status)->car; 654 return p->status; 655 } 656 657 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 658 1, 1, 0, 659 "Return the exit status of PROCESS or the signal number that killed it.\n\ 660 If PROCESS has not yet exited or died, return 0.") 661 (proc) 662 register Lisp_Object proc; 663 { 664 CHECK_PROCESS (proc, 0); 665 if (!NULL (XPROCESS (proc)->raw_status_low)) 666 update_status (XPROCESS (proc)); 667 if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons) 668 return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car; 669 return make_number (0); 670 } 671 672 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, 673 "Return the process id of PROCESS.\n\ 674 This is the pid of the Unix process which PROCESS uses or talks to.\n\ 675 For a network connection, this value is nil.") 676 (proc) 677 register Lisp_Object proc; 678 { 679 CHECK_PROCESS (proc, 0); 680 return XPROCESS (proc)->pid; 681 } 682 683 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, 684 "Return the name of PROCESS, as a string.\n\ 685 This is the name of the program invoked in PROCESS,\n\ 686 possibly modified to make it unique among process names.") 687 (proc) 688 register Lisp_Object proc; 689 { 690 CHECK_PROCESS (proc, 0); 691 return XPROCESS (proc)->name; 692 } 693 694 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, 695 "Return the command that was executed to start PROCESS.\n\ 696 This is a list of strings, the first string being the program executed\n\ 697 and the rest of the strings being the arguments given to it.\n\ 698 For a non-child channel, this is nil.") 699 (proc) 700 register Lisp_Object proc; 701 { 702 CHECK_PROCESS (proc, 0); 703 return XPROCESS (proc)->command; 704 } 705 706 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 707 2, 2, 0, 708 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") 709 (proc, buffer) 710 register Lisp_Object proc, buffer; 711 { 712 CHECK_PROCESS (proc, 0); 713 if (!NULL (buffer)) 714 CHECK_BUFFER (buffer, 1); 715 XPROCESS (proc)->buffer = buffer; 716 return buffer; 717 } 718 719 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, 720 1, 1, 0, 721 "Return the buffer PROCESS is associated with.\n\ 722 Output from PROCESS is inserted in this buffer\n\ 723 unless PROCESS has a filter.") 724 (proc) 725 register Lisp_Object proc; 726 { 727 CHECK_PROCESS (proc, 0); 728 return XPROCESS (proc)->buffer; 729 } 730 731 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, 732 1, 1, 0, 733 "Return the marker for the end of the last output from PROCESS.") 734 (proc) 735 register Lisp_Object proc; 736 { 737 CHECK_PROCESS (proc, 0); 738 return XPROCESS (proc)->mark; 739 } 740 741 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 742 2, 2, 0, 743 "Give PROCESS the filter function FILTER; nil means no filter.\n\ 744 When a process has a filter, each time it does output\n\ 745 the entire string of output is passed to the filter.\n\ 746 The filter gets two arguments: the process and the string of output.\n\ 747 If the process has a filter, its buffer is not used for output.") 748 (proc, filter) 749 register Lisp_Object proc, filter; 750 { 751 CHECK_PROCESS (proc, 0); 752 XPROCESS (proc)->filter = filter; 753 return filter; 754 } 755 756 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, 757 1, 1, 0, 758 "Returns the filter function of PROCESS; nil if none.\n\ 759 See set-process-filter for more info on filter functions.") 760 (proc) 761 register Lisp_Object proc; 762 { 763 CHECK_PROCESS (proc, 0); 764 return XPROCESS (proc)->filter; 765 } 766 767 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, 768 2, 2, 0, 769 "Give PROCESS the sentinel SENTINEL; nil for none.\n\ 770 The sentinel is called as a function when the process changes state.\n\ 771 It gets two arguments: the process, and a string describing the change.") 772 (proc, sentinel) 773 register Lisp_Object proc, sentinel; 774 { 775 CHECK_PROCESS (proc, 0); 776 XPROCESS (proc)->sentinel = sentinel; 777 return sentinel; 778 } 779 780 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, 781 1, 1, 0, 782 "Return the sentinel of PROCESS; nil if none.\n\ 783 See set-process-sentinel for more info on sentinels.") 784 (proc) 785 register Lisp_Object proc; 786 { 787 CHECK_PROCESS (proc, 0); 788 return XPROCESS (proc)->sentinel; 789 } 790 791 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 792 Sprocess_kill_without_query, 1, 2, 0, 793 "Say no query needed if PROCESS is running when Emacs is exited.\n\ 794 Optional second argument if non-nil says to require a query.\n\ 795 Value is t if a query was formerly required.") 796 (proc, value) 797 register Lisp_Object proc, value; 798 { 799 Lisp_Object tem; 800 CHECK_PROCESS (proc, 0); 801 tem = XPROCESS (proc)->kill_without_query; 802 XPROCESS (proc)->kill_without_query = Fnull (value); 803 return Fnull (tem); 804 } 805 806 Lisp_Object 807 list_processes_1 () 808 { 809 register Lisp_Object tail, tem; 810 Lisp_Object proc, minspace, tem1; 811 register struct buffer *old = current_buffer; 812 register struct Lisp_Process *p; 813 register int state; 814 char tembuf[80]; 815 816 XFASTINT (minspace) = 1; 817 818 set_buffer_internal (XBUFFER (Vstandard_output)); 819 Fbuffer_flush_undo (Vstandard_output); 820 821 current_buffer->truncate_lines = Qt; 822 823 write_string ("\ 824 Proc Status Buffer Command\n\ 825 ---- ------ ------ -------\n", -1); 826 827 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail)) 828 { 829 Lisp_Object symbol; 830 831 proc = Fcdr (Fcar (tail)); 832 p = XPROCESS (proc); 833 if (NULL (p->childp)) 834 continue; 835 836 Finsert (1, &p->name); 837 Findent_to (make_number (13), minspace); 838 839 if (!NULL (p->raw_status_low)) 840 update_status (p); 841 symbol = p->status; 842 if (XTYPE (p->status) == Lisp_Cons) 843 symbol = XCONS (p->status)->car; 844 845 if (EQ (symbol, Qsignal)) 846 { 847 Lisp_Object tem; 848 tem = Fcar (Fcdr (p->status)); 849 if (XINT (tem) < NSIG) 850 write_string (sys_siglist [XINT (tem)], -1); 851 else 852 Fprinc (symbol, Qnil); 853 } 854 else 855 Fprinc (symbol, Qnil); 856 857 if (EQ (symbol, Qexit)) 858 { 859 Lisp_Object tem; 860 tem = Fcar (Fcdr (p->status)); 861 if (XFASTINT (tem)) 862 { 863 sprintf (tembuf, " %d", XFASTINT (tem)); 864 write_string (tembuf, -1); 865 } 866 } 867 868 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) 869 remove_process (proc); 870 871 Findent_to (make_number (22), minspace); 872 if (NULL (p->buffer)) 873 InsStr ("(none)"); 874 else if (NULL (XBUFFER (p->buffer)->name)) 875 InsStr ("(Killed)"); 876 else 877 Finsert (1, &XBUFFER (p->buffer)->name); 878 879 Findent_to (make_number (37), minspace); 880 881 if (NETCONN_P (proc)) 882 { 883 sprintf (tembuf, "(network stream connection to %s)\n", 884 XSTRING (p->childp)->data); 885 InsStr (tembuf); 886 } 887 else 888 { 889 tem = p->command; 890 while (1) 891 { 892 tem1 = Fcar (tem); 893 Finsert (1, &tem1); 894 tem = Fcdr (tem); 895 if (NULL (tem)) 896 break; 897 InsStr (" "); 898 } 899 InsStr ("\n"); 900 } 901 } 902 903 return Qnil; 904 } 905 906 DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", 907 "Display a list of all processes.\n\ 908 \(Any processes listed as Exited or Signaled are actually eliminated\n\ 909 after the listing is made.)") 910 () 911 { 912 internal_with_output_to_temp_buffer ("*Process List*", 913 list_processes_1, Qnil); 914 return Qnil; 915 } 916 917 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, 918 "Return a list of all processes.") 919 () 920 { 921 return Fmapcar (Qcdr, Vprocess_alist); 922 } 923 924 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, 925 "Start a program in a subprocess. Return the process object for it.\n\ 926 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\ 927 NAME is name for process. It is modified if necessary to make it unique.\n\ 928 BUFFER is the buffer or (buffer-name) to associate with the process.\n\ 929 Process output goes at end of that buffer, unless you specify\n\ 930 an output stream or filter function to handle the output.\n\ 931 BUFFER may be also nil, meaning that this process is not associated\n\ 932 with any buffer\n\ 933 Third arg is program file name. It is searched for as in the shell.\n\ 934 Remaining arguments are strings to give program as arguments.") 935 (nargs, args) 936 int nargs; 937 register Lisp_Object *args; 938 { 939 Lisp_Object buffer, name, program, proc, tem; 940 register unsigned char **new_argv; 941 register int i; 942 943 buffer = args[1]; 944 if (!NULL (buffer)) 945 buffer = Fget_buffer_create (buffer); 946 947 name = args[0]; 948 CHECK_STRING (name, 0); 949 950 program = args[2]; 951 952 CHECK_STRING (program, 2); 953 954 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); 955 956 for (i = 3; i < nargs; i++) 957 { 958 tem = args[i]; 959 CHECK_STRING (tem, i); 960 new_argv[i - 2] = XSTRING (tem)->data; 961 } 962 new_argv[i - 2] = 0; 963 new_argv[0] = XSTRING (program)->data; 964 965 /* If program file name is not absolute, search our path for it */ 966 if (new_argv[0][0] != '/') 967 { 968 tem = Qnil; 969 openp (Vexec_path, program, "", &tem, 1); 970 if (NULL (tem)) 971 report_file_error ("Searching for program", Fcons (program, Qnil)); 972 new_argv[0] = XSTRING (tem)->data; 973 } 974 975 proc = make_process (name); 976 977 XPROCESS (proc)->childp = Qt; 978 XPROCESS (proc)->command_channel_p = Qnil; 979 XPROCESS (proc)->buffer = buffer; 980 XPROCESS (proc)->sentinel = Qnil; 981 XPROCESS (proc)->filter = Qnil; 982 XPROCESS (proc)->command = Flist (nargs - 2, args + 2); 983 984 create_process (proc, new_argv); 985 986 return proc; 987 } 988 989 create_process_1 (signo) 990 int signo; 991 { 992 #ifdef USG 993 /* USG systems forget handlers when they are used; 994 must reestablish each time */ 995 signal (signo, create_process_1); 996 #endif /* USG */ 997 } 998 999 #if 0 /* This doesn't work; see the note before sigchld_handler. */ 1000 #ifdef USG 1001 #ifdef SIGCHLD 1002 /* Mimic blocking of signals on system V, which doesn't really have it. */ 1003 1004 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */ 1005 int sigchld_deferred; 1006 1007 create_process_sigchld () 1008 { 1009 signal (SIGCHLD, create_process_sigchld); 1010 1011 sigchld_deferred = 1; 1012 } 1013 #endif 1014 #endif 1015 #endif 1016 1017 create_process (process, new_argv) 1018 Lisp_Object process; 1019 char **new_argv; 1020 { 1021 int pid, inchannel, outchannel, forkin, forkout; 1022 int sv[2]; 1023 #ifdef SIGCHLD 1024 int (*sigchld)(); 1025 #endif 1026 char **env; 1027 int pty_flag = 0; 1028 extern char **environ; 1029 1030 #ifdef MAINTAIN_ENVIRONMENT 1031 env = (char **) alloca (size_of_current_environ ()); 1032 get_current_environ (env); 1033 #else 1034 env = environ; 1035 #endif /* MAINTAIN_ENVIRONMENT */ 1036 1037 inchannel = outchannel = -1; 1038 1039 #ifdef HAVE_PTYS 1040 if (EQ (Vprocess_connection_type, Qt)) 1041 outchannel = inchannel = allocate_pty (); 1042 1043 if (inchannel >= 0) 1044 { 1045 #ifndef USG 1046 /* On USG systems it does not work to open 1047 the pty's tty here and then close and reopen it in the child. */ 1048 forkout = forkin = open (pty_name, O_RDWR, 0); 1049 if (forkin < 0) 1050 report_file_error ("Opening pty", Qnil); 1051 #else 1052 forkin = forkout = -1; 1053 #endif 1054 pty_flag = 1; 1055 } 1056 else 1057 #endif /* HAVE_PTYS */ 1058 #ifdef SKTPAIR 1059 { 1060 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0) 1061 report_file_error ("Opening socketpair", Qnil); 1062 outchannel = inchannel = sv[0]; 1063 forkout = forkin = sv[1]; 1064 } 1065 #else /* not SKTPAIR */ 1066 { 1067 pipe (sv); 1068 inchannel = sv[0]; 1069 forkout = sv[1]; 1070 pipe (sv); 1071 outchannel = sv[1]; 1072 forkin = sv[0]; 1073 } 1074 #endif /* not SKTPAIR */ 1075 1076 #if 0 1077 /* Replaced by close_process_descs */ 1078 set_exclusive_use (inchannel); 1079 set_exclusive_use (outchannel); 1080 #endif 1081 1082 /* Stride people say it's a mystery why this is needed 1083 as well as the O_NDELAY, but that it fails without this. */ 1084 #ifdef STRIDE 1085 { 1086 int one = 1; 1087 ioctl (inchannel, FIONBIO, &one); 1088 } 1089 #endif 1090 1091 #ifdef O_NONBLOCK 1092 fcntl (inchannel, F_SETFL, O_NONBLOCK); 1093 #else 1094 #ifdef O_NDELAY 1095 fcntl (inchannel, F_SETFL, O_NDELAY); 1096 #endif 1097 #endif 1098 1099 /* Record this as an active process, with its channels. 1100 As a result, child_setup will close Emacs's side of the pipes. */ 1101 chan_process[inchannel] = process; 1102 XFASTINT (XPROCESS (process)->infd) = inchannel; 1103 XFASTINT (XPROCESS (process)->outfd) = outchannel; 1104 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); 1105 XPROCESS (process)->status = Qrun; 1106 1107 /* Delay interrupts until we have a chance to store 1108 the new fork's pid in its process structure */ 1109 #ifdef SIGCHLD 1110 #ifdef BSD4_1 1111 sighold (SIGCHLD); 1112 #else /* not BSD4_1 */ 1113 #ifdef HPUX 1114 sigsetmask (1 << (SIGCHLD - 1)); 1115 #else /* not HPUX */ 1116 #if defined (BSD) || defined (UNIPLUS) 1117 sigsetmask (1 << (SIGCHLD - 1)); 1118 #else /* ordinary USG */ 1119 #if 0 1120 sigchld_deferred = 0; 1121 sigchld = (int (*)()) signal (SIGCHLD, create_process_sigchld); 1122 #endif 1123 #endif /* ordinary USG */ 1124 #endif /* not HPUX */ 1125 #endif /* not BSD4_1 */ 1126 #endif /* SIGCHLD */ 1127 1128 /* Until we store the proper pid, enable sigchld_handler 1129 to recognize an unknown pid as standing for this process. */ 1130 XSETINT (XPROCESS (process)->pid, -1); 1131 1132 { 1133 /* child_setup must clobber environ on systems with true vfork. 1134 Protect it from permanent change. */ 1135 char **save_environ = environ; 1136 1137 pid = vfork (); 1138 if (pid == 0) 1139 { 1140 int xforkin = forkin; 1141 int xforkout = forkout; 1142 1143 #if 0 /* This was probably a mistake--it duplicates code later on, 1144 but fails to handle all the cases. */ 1145 /* Make SIGCHLD work again in the child. */ 1146 sigsetmask (0); 1147 #endif 1148 1149 /* Make the pty be the controlling terminal of the process. */ 1150 #ifdef HAVE_PTYS 1151 /* First, disconnect its current controlling terminal. */ 1152 #ifdef HAVE_SETSID 1153 setsid (); 1154 #ifdef TIOCSCTTY 1155 /* Make the pty's terminal the controlling terminal. */ 1156 if (pty_flag && (ioctl (xforkin, TIOCSCTTY, 0) < 0)) 1157 abort (); 1158 #endif 1159 #else /* not HAVE_SETSID */ 1160 #ifdef USG 1161 /* It's very important to call setpgrp() here and no time 1162 afterwards. Otherwise, we lose our controlling tty which 1163 is set when we open the pty. */ 1164 setpgrp (); 1165 #endif /* USG */ 1166 #endif /* not HAVE_SETSID */ 1167 #ifdef TIOCNOTTY 1168 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you 1169 can do TIOCSPGRP only to the process's controlling tty. */ 1170 if (pty_flag) 1171 { 1172 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? 1173 I can't test it since I don't have 4.3. */ 1174 int j = open ("/dev/tty", O_RDWR, 0); 1175 ioctl (j, TIOCNOTTY, 0); 1176 close (j); 1177 #ifndef USG 1178 /* In order to get a controlling terminal on some versions 1179 of BSD, it is necessary to put the process in pgrp 0 1180 before it opens the terminal. */ 1181 setpgrp (0, 0); 1182 #endif 1183 } 1184 #endif /* TIOCNOTTY */ 1185 1186 #if !defined (RTU) && !defined (UNIPLUS) 1187 /*** There is a suggestion that this ought to be a 1188 conditional on TIOCSPGRP. */ 1189 /* Now close the pty (if we had it open) and reopen it. 1190 This makes the pty the controlling terminal of the subprocess. */ 1191 if (pty_flag) 1192 { 1193 /* I wonder if close (open (pty_name, ...)) would work? */ 1194 if (xforkin >= 0) 1195 close (xforkin); 1196 xforkout = xforkin = open (pty_name, O_RDWR, 0); 1197 1198 if (xforkin < 0) 1199 abort (); 1200 } 1201 #endif /* not UNIPLUS and not RTU */ 1202 #ifdef SETUP_SLAVE_PTY 1203 SETUP_SLAVE_PTY; 1204 #endif /* SETUP_SLAVE_PTY */ 1205 #ifdef AIX 1206 /* On AIX, we've disabled SIGHUP above once we start a child on a pty. 1207 Now reenable it in the child, so it will die when we want it to. */ 1208 if (pty_flag) 1209 signal (SIGHUP, SIG_DFL); 1210 #endif 1211 #endif /* HAVE_PTYS */ 1212 #ifdef SIGCHLD 1213 #ifdef BSD4_1 1214 sigrelse (SIGCHLD); 1215 #else /* not BSD4_1 */ 1216 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX) 1217 sigsetmask (0); 1218 #else /* ordinary USG */ 1219 signal (SIGCHLD, sigchld); 1220 #endif /* ordinary USG */ 1221 #endif /* not BSD4_1 */ 1222 #endif /* SIGCHLD */ 1223 child_setup_tty (xforkout); 1224 child_setup (xforkin, xforkout, xforkout, new_argv, env); 1225 } 1226 environ = save_environ; 1227 } 1228 1229 if (pid < 0) 1230 { 1231 remove_process (process); 1232 report_file_error ("Doing vfork", Qnil); 1233 } 1234 1235 XFASTINT (XPROCESS (process)->pid) = pid; 1236 1237 FD_SET (inchannel, &input_wait_mask); 1238 1239 /* If the subfork execv fails, and it exits, 1240 this close hangs. I don't know why. 1241 So have an interrupt jar it loose. */ 1242 stop_polling (); 1243 signal (SIGALRM, create_process_1); 1244 alarm (1); 1245 if (forkin >= 0) 1246 close (forkin); 1247 alarm (0); 1248 start_polling (); 1249 if (forkin != forkout && forkout >= 0) 1250 close (forkout); 1251 1252 #ifdef SIGCHLD 1253 #ifdef BSD4_1 1254 sigrelse (SIGCHLD); 1255 #else /* not BSD4_1 */ 1256 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX) 1257 sigsetmask (0); 1258 #else /* ordinary USG */ 1259 #if 0 1260 signal (SIGCHLD, sigchld); 1261 /* Now really handle any of these signals 1262 that came in during this function. */ 1263 if (sigchld_deferred) 1264 kill (getpid (), SIGCHLD); 1265 #endif 1266 #endif /* ordinary USG */ 1267 #endif /* not BSD4_1 */ 1268 #endif /* SIGCHLD */ 1269 } 1270 1271 #ifdef HAVE_SOCKETS 1272 1273 /* open a TCP network connection to a given HOST/SERVICE. Treated 1274 exactly like a normal process when reading and writing. Only 1275 differences are in status display and process deletion. A network 1276 connection has no PID; you cannot signal it. All you can do is 1277 deactivate and close it via delete-process */ 1278 1279 DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, 1280 4, 4, 0, 1281 "Open a TCP connection for a service to a host.\n\ 1282 Returns a subprocess-object to represent the connection.\n\ 1283 Input and output work as for subprocesses; `delete-process' closes it.\n\ 1284 Args are NAME BUFFER HOST SERVICE.\n\ 1285 NAME is name for process. It is modified if necessary to make it unique.\n\ 1286 BUFFER is the buffer (or buffer-name) to associate with the process.\n\ 1287 Process output goes at end of that buffer, unless you specify\n\ 1288 an output stream or filter function to handle the output.\n\ 1289 BUFFER may be also nil, meaning that this process is not associated\n\ 1290 with any buffer\n\ 1291 Third arg is name of the host to connect to.\n\ 1292 Fourth arg SERVICE is name of the service desired, or an integer\n\ 1293 specifying a port number to connect to.") 1294 (name, buffer, host, service) 1295 Lisp_Object name, buffer, host, service; 1296 { 1297 Lisp_Object proc; 1298 register int i; 1299 struct sockaddr_in address; 1300 struct servent *svc_info; 1301 struct hostent *host_info; 1302 int s, outch, inch; 1303 char errstring[80]; 1304 int port; 1305 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1306 1307 GCPRO4 (name, buffer, host, service); 1308 CHECK_STRING (name, 0); 1309 CHECK_STRING (host, 0); 1310 if (XTYPE(service) == Lisp_Int) 1311 port = htons ((unsigned short) XINT (service)); 1312 else 1313 { 1314 CHECK_STRING (service, 0); 1315 svc_info = getservbyname (XSTRING (service)->data, "tcp"); 1316 if (svc_info == 0) 1317 error ("Unknown service \"%s\"", XSTRING (service)->data); 1318 port = svc_info->s_port; 1319 } 1320 1321 host_info = gethostbyname (XSTRING (host)->data); 1322 if (host_info == 0) 1323 error ("Unknown host \"%s\"", XSTRING(host)->data); 1324 1325 bzero (&address, sizeof address); 1326 bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length); 1327 address.sin_family = host_info->h_addrtype; 1328 address.sin_port = port; 1329 1330 s = socket (host_info->h_addrtype, SOCK_STREAM, 0); 1331 if (s < 0) 1332 report_file_error ("error creating socket", Fcons (name, Qnil)); 1333 1334 if (connect (s, &address, sizeof address) == -1) 1335 { 1336 close (s); 1337 error ("Host \"%s\" not responding", XSTRING (host)->data); 1338 } 1339 1340 inch = s; 1341 outch = dup (s); 1342 if (outch < 0) 1343 report_file_error ("error duplicating socket", Fcons (name, Qnil)); 1344 1345 if (!NULL (buffer)) 1346 buffer = Fget_buffer_create (buffer); 1347 proc = make_process (name); 1348 1349 chan_process[inch] = proc; 1350 1351 #ifdef O_NONBLOCK 1352 fcntl (inch, F_SETFL, O_NONBLOCK); 1353 #else 1354 #ifdef O_NDELAY 1355 fcntl (inch, F_SETFL, O_NDELAY); 1356 #endif 1357 #endif 1358 1359 XPROCESS (proc)->childp = host; 1360 XPROCESS (proc)->command_channel_p = Qnil; 1361 XPROCESS (proc)->buffer = buffer; 1362 XPROCESS (proc)->sentinel = Qnil; 1363 XPROCESS (proc)->filter = Qnil; 1364 XPROCESS (proc)->command = Qnil; 1365 XPROCESS (proc)->pid = Qnil; 1366 XPROCESS (proc)->kill_without_query = Qt; 1367 XFASTINT (XPROCESS (proc)->infd) = s; 1368 XFASTINT (XPROCESS (proc)->outfd) = outch; 1369 XPROCESS (proc)->status = Qrun; 1370 FD_SET (inch, &input_wait_mask); 1371 1372 UNGCPRO; 1373 return proc; 1374 } 1375 #endif /* HAVE_SOCKETS */ 1376 1377 deactivate_process (proc) 1378 Lisp_Object proc; 1379 { 1380 register int inchannel, outchannel; 1381 register struct Lisp_Process *p = XPROCESS (proc); 1382 1383 inchannel = XFASTINT (p->infd); 1384 outchannel = XFASTINT (p->outfd); 1385 1386 if (inchannel) 1387 { 1388 /* Beware SIGCHLD hereabouts. */ 1389 flush_pending_output (inchannel); 1390 close (inchannel); 1391 if (outchannel && outchannel != inchannel) 1392 close (outchannel); 1393 1394 XFASTINT (p->infd) = 0; 1395 XFASTINT (p->outfd) = 0; 1396 chan_process[inchannel] = Qnil; 1397 FD_CLR (inchannel, &input_wait_mask); 1398 } 1399 } 1400 1401 /* Close all descriptors currently in use for communication 1402 with subprocess. This is used in a newly-forked subprocess 1403 to get rid of irrelevant descriptors. */ 1404 1405 close_process_descs () 1406 { 1407 int i; 1408 for (i = 0; i < MAXDESC; i++) 1409 { 1410 Lisp_Object process; 1411 process = chan_process[i]; 1412 if (!NULL (process)) 1413 { 1414 int in = XFASTINT (XPROCESS (process)->infd); 1415 int out = XFASTINT (XPROCESS (process)->outfd); 1416 close (in); 1417 if (in != out) 1418 close (out); 1419 } 1420 } 1421 } 1422 1423 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, 1424 0, 1, 0, 1425 "Allow any pending output from subprocesses to be read by Emacs.\n\ 1426 It is read into the process' buffers or given to their filter functions.\n\ 1427 Non-nil arg PROCESS means do not return until some output has been received\n\ 1428 from PROCESS.") 1429 (proc) 1430 register Lisp_Object proc; 1431 { 1432 if (NULL (proc)) 1433 wait_reading_process_input (-1, 0, 0); 1434 else 1435 { 1436 proc = get_process (proc); 1437 wait_reading_process_input (0, XPROCESS (proc), 0); 1438 } 1439 return Qnil; 1440 } 1441 1442 /* This variable is different from waiting_for_input in keyboard.c. 1443 It is used to communicate to a lisp process-filter/sentinel (via the 1444 function Fwaiting_for_user_input_p below) whether emacs was waiting 1445 for user-input when that process-filter was called. 1446 waiting_for_input cannot be used as that is by definition 0 when 1447 lisp code is being evalled */ 1448 static int waiting_for_user_input_p; 1449 1450 /* Read and dispose of subprocess output 1451 while waiting for timeout to elapse and/or keyboard input to be available. 1452 1453 time_limit is the timeout in seconds, or zero for no limit. 1454 -1 means gobble data available immediately but don't wait for any. 1455 1456 read_kbd is 1 to return when input is available. 1457 -1 means caller will actually read the input. 1458 A pointer to a struct Lisp_Process means wait until 1459 something arrives from that process. 1460 1461 do_display means redisplay should be done to show 1462 subprocess output that arrives. */ 1463 1464 wait_reading_process_input (time_limit, read_kbd, do_display) 1465 int time_limit, read_kbd, do_display; 1466 { 1467 register int channel, nfds, m; 1468 SELECT_TYPE Available; 1469 SELECT_TYPE Exception; 1470 int xerrno; 1471 Lisp_Object proc; 1472 #ifdef HAVE_TIMEVAL 1473 struct timeval timeout, end_time, garbage; 1474 #else 1475 long timeout, end_time, temp; 1476 #endif /* not HAVE_TIMEVAL */ 1477 SELECT_TYPE Atemp; 1478 int wait_channel = 0; 1479 struct Lisp_Process *wait_proc = 0; 1480 extern kbd_count; 1481 1482 /* Detect when read_kbd is really the address of a Lisp_Process. */ 1483 if (read_kbd > 10 || read_kbd < -1) 1484 { 1485 wait_proc = (struct Lisp_Process *) read_kbd; 1486 wait_channel = XFASTINT (wait_proc->infd); 1487 read_kbd = 0; 1488 } 1489 waiting_for_user_input_p = read_kbd; 1490 1491 /* Since we may need to wait several times, 1492 compute the absolute time to return at. */ 1493 if (time_limit) 1494 { 1495 #ifdef HAVE_TIMEVAL 1496 gettimeofday (&end_time, &garbage); 1497 end_time.tv_sec += time_limit; 1498 #else /* not HAVE_TIMEVAL */ 1499 time (&end_time); 1500 end_time += time_limit; 1501 #endif /* not HAVE_TIMEVAL */ 1502 } 1503 1504 #if 0 /* Select emulator claims to preserve alarms. 1505 And there are many ways to get out of this function by longjmp. */ 1506 /* Turn off periodic alarms (in case they are in use) 1507 because the select emulator uses alarms. */ 1508 stop_polling (); 1509 #endif 1510 1511 while (1) 1512 { 1513 /* If calling from keyboard input, do not quit 1514 since we want to return C-g as an input character. 1515 Otherwise, do pending quit if requested. */ 1516 if (read_kbd >= 0) 1517 { 1518 #if 0 1519 /* This is the same condition tested by QUIT. 1520 We need to resume polling if we are going to quit. */ 1521 if (!NULL (Vquit_flag) && NULL (Vinhibit_quit)) 1522 { 1523 start_polling (); 1524 QUIT; 1525 } 1526 #endif 1527 QUIT; 1528 } 1529 1530 /* If status of something has changed, and no input is available, 1531 notify the user of the change right away */ 1532 if (update_tick != process_tick && do_display) 1533 { 1534 Atemp = input_wait_mask; 1535 #ifdef HAVE_TIMEVAL 1536 timeout.tv_sec=0; timeout.tv_usec=0; 1537 #else /* not HAVE_TIMEVAL */ 1538 timeout = 0; 1539 #endif /* not HAVE_TIMEVAL */ 1540 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0) 1541 status_notify (); 1542 } 1543 1544 /* Don't wait for output from a non-running process. */ 1545 if (wait_proc != 0 && !NULL (wait_proc->raw_status_low)) 1546 update_status (wait_proc); 1547 if (wait_proc != 0 1548 && ! EQ (wait_proc->status, Qrun)) 1549 break; 1550 1551 if (fix_screen_hook) 1552 (*fix_screen_hook) (); 1553 1554 /* Compute time from now till when time limit is up */ 1555 /* Exit if already run out */ 1556 if (time_limit == -1) 1557 { 1558 /* -1 specified for timeout means 1559 gobble output available now 1560 but don't wait at all. */ 1561 #ifdef HAVE_TIMEVAL 1562 timeout.tv_sec = 0; 1563 timeout.tv_usec = 0; 1564 #else 1565 timeout = 0; 1566 #endif /* not HAVE_TIMEVAL */ 1567 } 1568 else if (time_limit) 1569 { 1570 #ifdef HAVE_TIMEVAL 1571 gettimeofday (&timeout, &garbage); 1572 timeout.tv_sec = end_time.tv_sec - timeout.tv_sec; 1573 timeout.tv_usec = end_time.tv_usec - timeout.tv_usec; 1574 if (timeout.tv_usec < 0) 1575 timeout.tv_usec += 1000000, 1576 timeout.tv_sec--; 1577 if (timeout.tv_sec < 0) 1578 break; 1579 #else /* not HAVE_TIMEVAL */ 1580 time (&temp); 1581 timeout = end_time - temp; 1582 if (timeout < 0) 1583 break; 1584 #endif /* not HAVE_TIMEVAL */ 1585 } 1586 else 1587 { 1588 #ifdef HAVE_TIMEVAL 1589 /* If no real timeout, loop sleeping with a big timeout 1590 so that input interrupt can wake us up by zeroing it */ 1591 timeout.tv_sec = 100; 1592 timeout.tv_usec = 0; 1593 #else /* not HAVE_TIMEVAL */ 1594 timeout = 100000; /* 100000 recognized by the select emulator */ 1595 #endif /* not HAVE_TIMEVAL */ 1596 } 1597 1598 /* Cause quitting and alarm signals to take immediate action, 1599 and cause input available signals to zero out timeout */ 1600 if (read_kbd < 0) 1601 set_waiting_for_input (&timeout); 1602 1603 /* Wait till there is something to do */ 1604 1605 Available = Exception = input_wait_mask; 1606 if (!read_kbd) 1607 FD_CLR (0, &Available); 1608 1609 if (read_kbd && kbd_count) 1610 nfds = 0; 1611 else 1612 #ifdef IBMRTAIX 1613 nfds = select (MAXDESC, &Available, 0, 0, &timeout); 1614 #else 1615 #ifdef HPUX 1616 nfds = select (MAXDESC, &Available, 0, 0, &timeout); 1617 #else 1618 nfds = select (MAXDESC, &Available, 0, &Exception, &timeout); 1619 #endif 1620 #endif 1621 xerrno = errno; 1622 1623 if (fix_screen_hook) 1624 (*fix_screen_hook) (); 1625 1626 /* Make C-g and alarm signals set flags again */ 1627 clear_waiting_for_input (); 1628 1629 /* If we woke up due to SIGWINCH, actually change size now. */ 1630 do_pending_window_change (); 1631 1632 if (time_limit && nfds == 0) /* timeout elapsed */ 1633 break; 1634 if (nfds < 0) 1635 { 1636 if (xerrno == EINTR) 1637 FD_ZERO (&Available); 1638 #ifdef ALLIANT 1639 /* This happens for no known reason on ALLIANT. 1640 I am guessing that this is the right response. -- RMS. */ 1641 else if (xerrno == EFAULT) 1642 FD_ZERO (&Available); 1643 #endif 1644 else if (xerrno == EBADF) 1645 #ifdef AIX 1646 /* AIX will return EBADF on a call to select involving a ptc if the 1647 associated pts isn't open. Since this will only happen just as 1648 a child is dying, just ignore the situation -- SIGCHLD will come 1649 along quite quickly, and after cleanup the ptc will no longer be 1650 checked, so this error will stop recurring. */ 1651 FD_ZERO (&Available); /* Cannot depend on values returned. */ 1652 #else /* not AIX */ 1653 abort (); 1654 #endif /* not AIX */ 1655 else 1656 error("select error: %s", sys_errlist[xerrno]); 1657 } 1658 #ifdef sun 1659 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input) 1660 /* System sometimes fails to deliver SIGIO. */ 1661 kill (getpid (), SIGIO); 1662 #endif 1663 1664 /* Check for keyboard input */ 1665 /* If there is any, return immediately 1666 to give it higher priority than subprocesses */ 1667 1668 if (read_kbd && detect_input_pending ()) 1669 break; 1670 1671 #ifdef vipc 1672 /* Check for connection from other process */ 1673 1674 if (FD_ISSET (comm_server, &Available)) 1675 { 1676 FD_CLR (comm_server, &Available); 1677 create_commchan (); 1678 } 1679 #endif vipc 1680 1681 /* Check for data from a process or a command channel */ 1682 1683 for (channel = 3; channel < MAXDESC; channel++) 1684 { 1685 if (FD_ISSET (channel, &Available)) 1686 { 1687 int nread; 1688 1689 FD_CLR (channel, &Available); 1690 /* If waiting for this channel, 1691 arrange to return as soon as no more input 1692 to be processed. No more waiting. */ 1693 if (wait_channel == channel) 1694 { 1695 wait_channel = 0; 1696 time_limit = -1; 1697 } 1698 proc = chan_process[channel]; 1699 if (NULL (proc)) 1700 continue; 1701 1702 #ifdef vipc 1703 /* It's a command channel */ 1704 if (!NULL (XPROCESS (proc)->command_channel_p)) 1705 { 1706 ProcessCommChan (channel, proc); 1707 if (NULL (XPROCESS (proc)->command_channel_p)) 1708 { 1709 /* It has ceased to be a command channel! */ 1710 int bytes_available; 1711 if (ioctl (channel, FIONREAD, &bytes_available) < 0) 1712 bytes_available = 0; 1713 if (bytes_available) 1714 FD_SET (channel, &Available); 1715 } 1716 continue; 1717 } 1718 #endif vipc 1719 1720 /* Read data from the process, starting with our 1721 buffered-ahead character if we have one. */ 1722 1723 nread = read_process_output (proc, channel); 1724 if (nread > 0) 1725 { 1726 /* Since read_process_output can run a filter, 1727 which can call accept-process-output, 1728 don't try to read from any other processes 1729 before doing the select again. */ 1730 FD_ZERO (&Available); 1731 1732 if (do_display) 1733 redisplay_preserve_echo_area (); 1734 } 1735 #ifdef EWOULDBLOCK 1736 else if (nread == -1 && errno == EWOULDBLOCK) 1737 ; 1738 #else 1739 #ifdef O_NONBLOCK 1740 else if (nread == -1 && errno == EAGAIN) 1741 ; 1742 #else 1743 #ifdef O_NDELAY 1744 else if (nread == -1 && errno == EAGAIN) 1745 ; 1746 /* Note that we cannot distinguish between no input 1747 available now and a closed pipe. 1748 With luck, a closed pipe will be accompanied by 1749 subprocess termination and SIGCHLD. */ 1750 else if (nread == 0) 1751 ; 1752 #endif /* O_NDELAY */ 1753 #endif /* O_NONBLOCK */ 1754 #endif /* EWOULDBLOCK */ 1755 #ifdef HAVE_PTYS 1756 /* On some OSs with ptys, when the process on one end of 1757 a pty exits, the other end gets an error reading with 1758 errno = EIO instead of getting an EOF (0 bytes read). 1759 Therefore, if we get an error reading and errno = 1760 EIO, just continue, because the child process has 1761 exited and should clean itself up soon (e.g. when we 1762 get a SIGCHLD). */ 1763 else if (nread == -1 && errno == EIO) 1764 ; 1765 #endif /* HAVE_PTYS */ 1766 /* If we can detect process termination, don't consider the process 1767 gone just because its pipe is closed. */ 1768 #ifdef SIGCHLD 1769 else if (nread == 0) 1770 ; 1771 #endif 1772 else 1773 { 1774 /* Preserve status of processes already terminated. */ 1775 XSETINT (XPROCESS (proc)->tick, ++process_tick); 1776 deactivate_process (proc); 1777 if (!NULL (XPROCESS (proc)->raw_status_low)) 1778 update_status (XPROCESS (proc)); 1779 if (EQ (XPROCESS (proc)->status, Qrun)) 1780 XPROCESS (proc)->status 1781 = Fcons (Qexit, Fcons (make_number (256), Qnil)); 1782 } 1783 } 1784 } /* end for */ 1785 } /* end while */ 1786 1787 #if 0 1788 /* Resume periodic signals to poll for input, if necessary. */ 1789 start_polling (); 1790 #endif 1791 } 1792 1793 /* Actually call the filter. This gets the information via variables 1794 because internal_condition_case won't pass arguments. */ 1795 1796 Lisp_Object 1797 run_filter () 1798 { 1799 return call2 (this_filter, filter_process, filter_string); 1800 } 1801 1802 /* Read pending output from the process channel, 1803 starting with our buffered-ahead character if we have one. 1804 Yield number of characters read. 1805 1806 This function reads at most 1024 characters. 1807 If you want to read all available subprocess output, 1808 you must call it repeatedly until it returns zero. */ 1809 1810 read_process_output (proc, channel) 1811 Lisp_Object proc; 1812 register int channel; 1813 { 1814 register int nchars; 1815 char chars[1024]; 1816 register Lisp_Object outstream; 1817 register struct buffer *old = current_buffer; 1818 register struct Lisp_Process *p = XPROCESS (proc); 1819 register int opoint; 1820 1821 if (proc_buffered_char[channel] < 0) 1822 nchars = read (channel, chars, sizeof chars); 1823 else 1824 { 1825 chars[0] = proc_buffered_char[channel]; 1826 proc_buffered_char[channel] = -1; 1827 nchars = read (channel, chars + 1, sizeof chars - 1); 1828 if (nchars < 0) 1829 nchars = 1; 1830 else 1831 nchars = nchars + 1; 1832 } 1833 1834 if (nchars <= 0) return nchars; 1835 1836 outstream = p->filter; 1837 if (!NULL (outstream)) 1838 { 1839 int count = specpdl_ptr - specpdl; 1840 specbind (Qinhibit_quit, Qt); 1841 this_filter = outstream; 1842 filter_process = proc; 1843 filter_string = make_string (chars, nchars); 1844 call2 (this_filter, filter_process, filter_string); 1845 /* internal_condition_case (run_filter, Qerror, Fidentity); */ 1846 unbind_to (count); 1847 return nchars; 1848 } 1849 1850 /* If no filter, write into buffer if it isn't dead. */ 1851 if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name)) 1852 { 1853 Lisp_Object tem; 1854 1855 Fset_buffer (p->buffer); 1856 opoint = point; 1857 1858 /* Insert new output into buffer 1859 at the current end-of-output marker, 1860 thus preserving logical ordering of input and output. */ 1861 if (XMARKER (p->mark)->buffer) 1862 SET_PT (marker_position (p->mark)); 1863 else 1864 SET_PT (ZV); 1865 if (point <= opoint) 1866 opoint += nchars; 1867 1868 tem = current_buffer->read_only; 1869 current_buffer->read_only = Qnil; 1870 insert (chars, nchars); 1871 current_buffer->read_only = tem; 1872 Fset_marker (p->mark, make_number (point), p->buffer); 1873 update_mode_lines++; 1874 1875 SET_PT (opoint); 1876 set_buffer_internal (old); 1877 } 1878 return nchars; 1879 } 1880 1881 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 1882 0, 0, 0, 1883 "Returns non-NIL if emacs is waiting for input from the user.\n\ 1884 This is intended for use by asynchronous process output filters and sentinels.") 1885 () 1886 { 1887 return ((waiting_for_user_input_p) ? Qt : Qnil); 1888 } 1889 1890 /* Sending data to subprocess */ 1891 1892 jmp_buf send_process_frame; 1893 1894 send_process_trap () 1895 { 1896 #ifdef BSD4_1 1897 sigrelse (SIGPIPE); 1898 sigrelse (SIGALRM); 1899 #endif /* BSD4_1 */ 1900 longjmp (send_process_frame, 1); 1901 } 1902 1903 send_process (proc, buf, len) 1904 Lisp_Object proc; 1905 char *buf; 1906 int len; 1907 { 1908 /* Don't use register vars; longjmp can lose them. */ 1909 int rv; 1910 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; 1911 1912 if (!NULL (XPROCESS (proc)->raw_status_low)) 1913 update_status (XPROCESS (proc)); 1914 if (! EQ (XPROCESS (proc)->status, Qrun)) 1915 error ("Process %s not running", procname); 1916 1917 if (!setjmp (send_process_frame)) 1918 while (len > 0) 1919 { 1920 signal (SIGPIPE, send_process_trap); 1921 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len); 1922 signal (SIGPIPE, SIG_DFL); 1923 if (rv < 0) 1924 { 1925 #ifdef EWOULDBLOCK 1926 if (errno == EWOULDBLOCK) 1927 { 1928 /* It would be nice to accept process output here, 1929 but that is difficult. For example, it could 1930 garbage what we are sending if that is from a buffer. */ 1931 immediate_quit = 1; 1932 QUIT; 1933 sleep (1); 1934 immediate_quit = 0; 1935 continue; 1936 } 1937 #endif 1938 report_file_error ("writing to process", Fcons (proc, Qnil)); 1939 } 1940 buf += rv; 1941 len -= rv; 1942 } 1943 else 1944 { 1945 XPROCESS (proc)->raw_status_low = Qnil; 1946 XPROCESS (proc)->raw_status_high = Qnil; 1947 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); 1948 XSETINT (XPROCESS (proc)->tick, ++process_tick); 1949 deactivate_process (proc); 1950 error ("SIGPIPE raised on process %s; closed it", procname); 1951 } 1952 } 1953 1954 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, 1955 3, 3, 0, 1956 "Send current contents of region as input to PROCESS.\n\ 1957 PROCESS may be a process name.\n\ 1958 Called from program, takes three arguments, PROCESS, START and END.") 1959 (process, start, end) 1960 Lisp_Object process, start, end; 1961 { 1962 Lisp_Object proc; 1963 int start1; 1964 1965 proc = get_process (process); 1966 validate_region (&start, &end); 1967 1968 if (XINT (start) < GPT && XINT (end) > GPT) 1969 move_gap (start); 1970 1971 start1 = XINT (start); 1972 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start)); 1973 1974 return Qnil; 1975 } 1976 1977 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, 1978 2, 2, 0, 1979 "Send PROCESS the contents of STRING as input.\n\ 1980 PROCESS may be a process name.") 1981 (process, string) 1982 Lisp_Object process, string; 1983 { 1984 Lisp_Object proc; 1985 CHECK_STRING (string, 1); 1986 proc = get_process (process); 1987 send_process (proc, XSTRING (string)->data, XSTRING (string)->size); 1988 return Qnil; 1989 } 1990 1991 /* send a signal number SIGNO to PROCESS. 1992 CURRENT_GROUP means send to the process group that currently owns 1993 the terminal being used to communicate with PROCESS. 1994 This is used for various commands in shell mode. 1995 If NOMSG is zero, insert signal-announcements into process's buffers 1996 right away. */ 1997 1998 process_send_signal (process, signo, current_group, nomsg) 1999 Lisp_Object process; 2000 int signo; 2001 Lisp_Object current_group; 2002 int nomsg; 2003 { 2004 Lisp_Object proc; 2005 register struct Lisp_Process *p; 2006 int gid; 2007 2008 proc = get_process (process); 2009 p = XPROCESS (proc); 2010 2011 if (!EQ (p->childp, Qt)) 2012 error ("Process %s is not a subprocess", 2013 XSTRING (p->name)->data); 2014 if (!XFASTINT (p->infd)) 2015 error ("Process %s is not active", 2016 XSTRING (p->name)->data); 2017 2018 if (NULL (p->pty_flag)) 2019 current_group = Qnil; 2020 2021 #ifdef TIOCGPGRP /* Not sure about this! (fnf) */ 2022 /* If we are using pgrps, get a pgrp number and make it negative. */ 2023 if (!NULL (current_group)) 2024 { 2025 ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid); 2026 gid = - gid; 2027 } 2028 else 2029 gid = - XFASTINT (p->pid); 2030 #else /* not using pgrps */ 2031 /* Can't select pgrps on this system, so we know that 2032 the child itself heads the pgrp. */ 2033 gid = - XFASTINT (p->pid); 2034 #endif /* not using pgrps */ 2035 2036 switch (signo) 2037 { 2038 #ifdef SIGCONT 2039 case SIGCONT: 2040 p->raw_status_low = Qnil; 2041 p->raw_status_high = Qnil; 2042 p->status = Qrun; 2043 XSETINT (p->tick, ++process_tick); 2044 if (!nomsg) 2045 status_notify (); 2046 break; 2047 #endif 2048 case SIGINT: 2049 case SIGQUIT: 2050 case SIGKILL: 2051 flush_pending_output (XFASTINT (p->infd)); 2052 break; 2053 } 2054 /* gid may be a pid, or minus a pgrp's number */ 2055 #ifdef TIOCSIGSEND 2056 if (!NULL (current_group)) 2057 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo); 2058 else 2059 { 2060 gid = - XFASTINT (p->pid); 2061 kill (gid, signo); 2062 } 2063 #else /* no TIOCSIGSEND */ 2064 #ifdef BSD 2065 /* On bsd, [man says] kill does not accept a negative number to kill a pgrp. 2066 Must do that differently. */ 2067 killpg (-gid, signo); 2068 #else /* Not BSD. */ 2069 kill (gid, signo); 2070 #endif /* Not BSD. */ 2071 #endif /* no TIOCSIGSEND */ 2072 } 2073 2074 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, 2075 "Interrupt process PROCESS. May be process or name of one.\n\ 2076 Nil or no arg means current buffer's process.\n\ 2077 Second arg CURRENT-GROUP non-nil means send signal to\n\ 2078 the current process-group of the process's controlling terminal\n\ 2079 rather than to the process's own process group.\n\ 2080 If the process is a shell, this means interrupt current subjob\n\ 2081 rather than the shell.") 2082 (process, current_group) 2083 Lisp_Object process, current_group; 2084 { 2085 process_send_signal (process, SIGINT, current_group, 0); 2086 return process; 2087 } 2088 2089 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, 2090 "Kill process PROCESS. May be process or name of one.\n\ 2091 See function interrupt-process for more details on usage.") 2092 (process, current_group) 2093 Lisp_Object process, current_group; 2094 { 2095 process_send_signal (process, SIGKILL, current_group, 0); 2096 return process; 2097 } 2098 2099 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0, 2100 "Send QUIT signal to process PROCESS. May be process or name of one.\n\ 2101 See function interrupt-process for more details on usage.") 2102 (process, current_group) 2103 Lisp_Object process, current_group; 2104 { 2105 process_send_signal (process, SIGQUIT, current_group, 0); 2106 return process; 2107 } 2108 2109 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, 2110 "Stop process PROCESS. May be process or name of one.\n\ 2111 See function interrupt-process for more details on usage.") 2112 (process, current_group) 2113 Lisp_Object process, current_group; 2114 { 2115 #ifndef SIGTSTP 2116 error ("no SIGTSTP support"); 2117 #else 2118 process_send_signal (process, SIGTSTP, current_group, 0); 2119 #endif 2120 return process; 2121 } 2122 2123 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, 2124 "Continue process PROCESS. May be process or name of one.\n\ 2125 See function interrupt-process for more details on usage.") 2126 (process, current_group) 2127 Lisp_Object process, current_group; 2128 { 2129 #ifdef SIGCONT 2130 process_send_signal (process, SIGCONT, current_group, 0); 2131 #else 2132 error ("no SIGCONT support"); 2133 #endif 2134 return process; 2135 } 2136 2137 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, 2138 "Make PROCESS see end-of-file in its input.\n\ 2139 Eof comes after any text already sent to it.\n\ 2140 nil or no arg means current buffer's process.") 2141 (process) 2142 Lisp_Object process; 2143 { 2144 Lisp_Object proc; 2145 2146 proc = get_process (process); 2147 /* Sending a zero-length record is supposed to mean eof 2148 when TIOCREMOTE is turned on. */ 2149 #ifdef DID_REMOTE 2150 { 2151 char buf[1]; 2152 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0); 2153 } 2154 #else /* did not do TOICREMOTE */ 2155 send_process (proc, "\004", 1); 2156 #endif /* did not do TOICREMOTE */ 2157 return process; 2158 } 2159 2160 /* Kill all processes associated with `buffer'. 2161 If `buffer' is nil, kill all processes */ 2162 2163 kill_buffer_processes (buffer) 2164 Lisp_Object buffer; 2165 { 2166 Lisp_Object tail, proc; 2167 2168 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons; 2169 tail = XCONS (tail)->cdr) 2170 { 2171 proc = XCONS (XCONS (tail)->car)->cdr; 2172 if (XGCTYPE (proc) == Lisp_Process 2173 && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) 2174 { 2175 if (NETCONN_P (proc)) 2176 deactivate_process (proc); 2177 else if (XFASTINT (XPROCESS (proc)->infd)) 2178 process_send_signal (proc, SIGHUP, Qnil, 1); 2179 } 2180 } 2181 } 2182 2183 /* On receipt of a signal that a child status has changed, 2184 loop asking about children with changed statuses until 2185 the system says there are no more. 2186 All we do is change the status; 2187 we do not run sentinels or print notifications. 2188 That is saved for the next time keyboard input is done, 2189 in order to avoid timing errors. */ 2190 2191 /** WARNING: this can be called during garbage collection. 2192 Therefore, it must not be fooled by the presence of mark bits in 2193 Lisp objects. */ 2194 2195 /** USG WARNING: Although it is not obvious from the documentation 2196 in signal(2), on a USG system the SIGCLD handler MUST NOT call 2197 signal() before executing at least one wait(), otherwise the handler 2198 will be called again, resulting in an infinite loop. The relevant 2199 portion of the documentation reads "SIGCLD signals will be queued 2200 and the signal-catching function will be continually reentered until 2201 the queue is empty". Invoking signal() causes the kernel to reexamine 2202 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */ 2203 2204 sigchld_handler (signo) 2205 int signo; 2206 { 2207 int old_errno = errno; 2208 Lisp_Object proc; 2209 register struct Lisp_Process *p; 2210 2211 #ifdef BSD4_1 2212 extern int synch_process_pid; 2213 extern int sigheld; 2214 sigheld |= sigbit (SIGCHLD); 2215 #endif 2216 2217 while (1) 2218 { 2219 register int pid; 2220 WAITTYPE w; 2221 Lisp_Object tail; 2222 2223 #ifdef WNOHANG 2224 #ifndef WUNTRACED 2225 #define WUNTRACED 0 2226 #endif /* no WUNTRACED */ 2227 /* Keep trying to get a status until we get a definitive result. */ 2228 do 2229 { 2230 errno = 0; 2231 pid = wait3 (&w, WNOHANG | WUNTRACED, 0); 2232 } 2233 while (pid <= 0 && errno == EINTR); 2234 2235 if (pid <= 0) 2236 { 2237 /* A real failure. We have done all our job, so return. */ 2238 2239 /* USG systems forget handlers when they are used; 2240 must reestablish each time */ 2241 #ifdef USG 2242 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */ 2243 #endif 2244 #ifdef BSD4_1 2245 sigheld &= ~sigbit (SIGCHLD); 2246 sigrelse (SIGCHLD); 2247 #endif 2248 errno = old_errno; 2249 return; 2250 } 2251 #else 2252 pid = wait (&w); 2253 #endif /* no WNOHANG */ 2254 2255 #ifdef BSD4_1 2256 if (synch_process_pid == pid) 2257 synch_process_pid = 0; /* Zero it to show process has died. */ 2258 #endif 2259 2260 /* Find the process that signaled us, and record its status. */ 2261 2262 p = 0; 2263 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) 2264 { 2265 proc = XCONS (XCONS (tail)->car)->cdr; 2266 p = XPROCESS (proc); 2267 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid) 2268 break; 2269 p = 0; 2270 } 2271 2272 /* If we don't recognize the pid number, 2273 look for a process being created. */ 2274 2275 if (p == 0) 2276 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) 2277 { 2278 proc = XCONS (XCONS (tail)->car)->cdr; 2279 p = XPROCESS (proc); 2280 if (XINT (p->pid) == -1) 2281 break; 2282 p = 0; 2283 } 2284 2285 /* Change the status of the process that was found. */ 2286 2287 if (p != 0) 2288 { 2289 union { int i; WAITTYPE wt; } u; 2290 2291 XSETINT (p->tick, ++process_tick); 2292 u.wt = w; 2293 XFASTINT (p->raw_status_low) = u.i & 0xffff; 2294 XFASTINT (p->raw_status_high) = u.i >> 16; 2295 2296 /* If process has terminated, stop waiting for its output. */ 2297 if (WIFSIGNALED (w) || WIFEXITED (w)) 2298 if (p->infd) 2299 FD_CLR (p->infd, &input_wait_mask); 2300 } 2301 2302 /* On some systems, we must return right away. 2303 If any more processes want to signal us, we will 2304 get another signal. 2305 Otherwise (on systems that have WNOHANG), loop around 2306 to use up all the processes that have something to tell us. */ 2307 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) 2308 #ifdef USG 2309 signal (signo, sigchld_handler); 2310 #endif 2311 errno = old_errno; 2312 return; 2313 #endif /* USG, but not HPUX with WNOHANG */ 2314 } 2315 } 2316 2317 /* Report all recent events of a change in process status 2318 (either run the sentinel or output a message). 2319 This is done while Emacs is waiting for keyboard input. */ 2320 2321 status_notify () 2322 { 2323 register Lisp_Object tail, proc, buffer; 2324 2325 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail)) 2326 { 2327 Lisp_Object symbol, msg; 2328 register struct Lisp_Process *p; 2329 2330 proc = Fcdr (Fcar (tail)); 2331 p = XPROCESS (proc); 2332 2333 if (XINT (p->tick) != XINT (p->update_tick)) 2334 { 2335 struct gcpro gcpro1; 2336 2337 XSETINT (p->update_tick, XINT (p->tick)); 2338 2339 /* If process is still active, read any output that remains. */ 2340 if (XFASTINT (p->infd)) 2341 while (read_process_output (proc, XFASTINT (p->infd)) > 0); 2342 2343 buffer = p->buffer; 2344 2345 /* Get the text to use for the message. */ 2346 if (!NULL (p->raw_status_low)) 2347 update_status (p); 2348 msg = status_message (p->status); 2349 GCPRO1 (msg); 2350 2351 /* If process is terminated, deactivate it or delete it. */ 2352 symbol = p->status; 2353 if (XTYPE (p->status) == Lisp_Cons) 2354 symbol = XCONS (p->status)->car; 2355 2356 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) 2357 || EQ (symbol, Qclosed)) 2358 { 2359 if (delete_exited_processes) 2360 remove_process (proc); 2361 else 2362 deactivate_process (proc); 2363 } 2364 UNGCPRO; 2365 2366 /* Now output the message suitably. */ 2367 if (!NULL (p->sentinel)) 2368 exec_sentinel (proc, msg); 2369 /* Don't bother with a message in the buffer 2370 when a process becomes runnable. */ 2371 else if (!EQ (symbol, Qrun) && !NULL (buffer)) 2372 { 2373 Lisp_Object ro = XBUFFER (buffer)->read_only; 2374 Lisp_Object tem; 2375 struct buffer *old = current_buffer; 2376 int opoint; 2377 2378 /* Avoid error if buffer is deleted 2379 (probably that's why the process is dead, too) */ 2380 if (NULL (XBUFFER (buffer)->name)) 2381 continue; 2382 Fset_buffer (buffer); 2383 opoint = point; 2384 /* Insert new output into buffer 2385 at the current end-of-output marker, 2386 thus preserving logical ordering of input and output. */ 2387 if (XMARKER (p->mark)->buffer) 2388 SET_PT (marker_position (p->mark)); 2389 else 2390 SET_PT (ZV); 2391 if (point <= opoint) 2392 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10; 2393 2394 tem = current_buffer->read_only; 2395 current_buffer->read_only = Qnil; 2396 GCPRO1 (msg); 2397 InsStr ("\nProcess "); 2398 Finsert (1, &p->name); 2399 InsStr (" "); 2400 Finsert (1, &msg); 2401 current_buffer->read_only = tem; 2402 Fset_marker (p->mark, make_number (point), p->buffer); 2403 UNGCPRO; 2404 2405 SET_PT (opoint); 2406 set_buffer_internal (old); 2407 } 2408 } 2409 } /* end for */ 2410 2411 update_mode_lines++; /* in case buffers use %s in mode-line-format */ 2412 redisplay_preserve_echo_area (); 2413 2414 update_tick = process_tick; 2415 } 2416 2417 exec_sentinel (proc, reason) 2418 Lisp_Object proc, reason; 2419 { 2420 Lisp_Object sentinel; 2421 register struct Lisp_Process *p = XPROCESS (proc); 2422 int count = specpdl_ptr - specpdl; 2423 2424 sentinel = p->sentinel; 2425 if (NULL (sentinel)) 2426 return; 2427 2428 p->sentinel = Qnil; 2429 specbind (Qinhibit_quit, Qt); 2430 this_filter = sentinel; 2431 filter_process = proc; 2432 filter_string = reason; 2433 call2 (this_filter, filter_process, filter_string); 2434 /* internal_condition_case (run_filter, Qerror, Fidentity); */ 2435 unbind_to (count); 2436 p->sentinel = sentinel; 2437 } 2438 2439 init_process () 2440 { 2441 register int i; 2442 2443 #ifdef SIGCHLD 2444 #ifndef CANNOT_DUMP 2445 if (! noninteractive || initialized) 2446 #endif 2447 signal (SIGCHLD, sigchld_handler); 2448 #endif 2449 2450 FD_ZERO (&input_wait_mask); 2451 FD_SET (0, &input_wait_mask); 2452 Vprocess_alist = Qnil; 2453 for (i = 0; i < MAXDESC; i++) 2454 { 2455 chan_process[i] = Qnil; 2456 proc_buffered_char[i] = -1; 2457 } 2458 } 2459 2460 syms_of_process () 2461 { 2462 Qprocessp = intern ("processp"); 2463 staticpro (&Qprocessp); 2464 Qrun = intern ("run"); 2465 staticpro (&Qrun); 2466 Qstop = intern ("stop"); 2467 staticpro (&Qstop); 2468 Qsignal = intern ("signal"); 2469 staticpro (&Qsignal); 2470 Qexit = intern ("exit"); 2471 staticpro (&Qexit); 2472 Qopen = intern ("open"); 2473 staticpro (&Qopen); 2474 Qclosed = intern ("closed"); 2475 staticpro (&Qclosed); 2476 2477 staticpro (&Vprocess_alist); 2478 2479 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, 2480 "*Non-nil means delete processes immediately when they exit.\n\ 2481 nil means don't delete them until `list-processes' is run."); 2482 2483 delete_exited_processes = 1; 2484 2485 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, 2486 "Control type of device used to communicate with subprocesses.\n\ 2487 Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\ 2488 Value takes effect when `start-process' is called."); 2489 Vprocess_connection_type = Qt; 2490 2491 defsubr (&Sprocessp); 2492 defsubr (&Sget_process); 2493 defsubr (&Sget_buffer_process); 2494 defsubr (&Sdelete_process); 2495 defsubr (&Sprocess_status); 2496 defsubr (&Sprocess_exit_status); 2497 defsubr (&Sprocess_id); 2498 defsubr (&Sprocess_name); 2499 defsubr (&Sprocess_command); 2500 defsubr (&Sset_process_buffer); 2501 defsubr (&Sprocess_buffer); 2502 defsubr (&Sprocess_mark); 2503 defsubr (&Sset_process_filter); 2504 defsubr (&Sprocess_filter); 2505 defsubr (&Sset_process_sentinel); 2506 defsubr (&Sprocess_sentinel); 2507 defsubr (&Sprocess_kill_without_query); 2508 defsubr (&Slist_processes); 2509 defsubr (&Sprocess_list); 2510 defsubr (&Sstart_process); 2511 #ifdef HAVE_SOCKETS 2512 defsubr (&Sopen_network_stream); 2513 #endif /* HAVE_SOCKETS */ 2514 defsubr (&Saccept_process_output); 2515 defsubr (&Sprocess_send_region); 2516 defsubr (&Sprocess_send_string); 2517 defsubr (&Sinterrupt_process); 2518 defsubr (&Skill_process); 2519 defsubr (&Squit_process); 2520 defsubr (&Sstop_process); 2521 defsubr (&Scontinue_process); 2522 defsubr (&Sprocess_send_eof); 2523 defsubr (&Swaiting_for_user_input_p); 2524 } 2525 2526 #endif subprocesses 2527