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