1/* Asynchronous subprocess control for GNU Emacs. 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 3 1996, 1998, 1999, 2001, 2002, 2003, 2004, 4 2005, 2006, 2007 Free Software Foundation, Inc. 5 6This file is part of GNU Emacs. 7 8GNU Emacs is free software; you can redistribute it and/or modify 9it under the terms of the GNU General Public License as published by 10the Free Software Foundation; either version 2, or (at your option) 11any later version. 12 13GNU Emacs is distributed in the hope that it will be useful, 14but WITHOUT ANY WARRANTY; without even the implied warranty of 15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16GNU General Public License for more details. 17 18You should have received a copy of the GNU General Public License 19along with GNU Emacs; see the file COPYING. If not, write to 20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 21Boston, MA 02110-1301, USA. */ 22 23 24#include <config.h> 25#include <signal.h> 26 27/* This file is split into two parts by the following preprocessor 28 conditional. The 'then' clause contains all of the support for 29 asynchronous subprocesses. The 'else' clause contains stub 30 versions of some of the asynchronous subprocess routines that are 31 often called elsewhere in Emacs, so we don't have to #ifdef the 32 sections that call them. */ 33 34 35#ifdef subprocesses 36 37#include <stdio.h> 38#include <errno.h> 39#include <setjmp.h> 40#include <sys/types.h> /* some typedefs are used in sys/file.h */ 41#include <sys/file.h> 42#include <sys/stat.h> 43#ifdef HAVE_INTTYPES_H 44#include <inttypes.h> 45#endif 46#ifdef HAVE_UNISTD_H 47#include <unistd.h> 48#endif 49 50#if defined(WINDOWSNT) || defined(UNIX98_PTYS) 51#include <stdlib.h> 52#include <fcntl.h> 53#endif /* not WINDOWSNT */ 54 55#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */ 56#include <sys/socket.h> 57#include <netdb.h> 58#include <netinet/in.h> 59#include <arpa/inet.h> 60#ifdef NEED_NET_ERRNO_H 61#include <net/errno.h> 62#endif /* NEED_NET_ERRNO_H */ 63 64/* Are local (unix) sockets supported? */ 65#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM) 66#if !defined (AF_LOCAL) && defined (AF_UNIX) 67#define AF_LOCAL AF_UNIX 68#endif 69#ifdef AF_LOCAL 70#define HAVE_LOCAL_SOCKETS 71#include <sys/un.h> 72#endif 73#endif 74#endif /* HAVE_SOCKETS */ 75 76/* TERM is a poor-man's SLIP, used on GNU/Linux. */ 77#ifdef TERM 78#include <client.h> 79#endif 80 81/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */ 82#ifdef HAVE_BROKEN_INET_ADDR 83#define IN_ADDR struct in_addr 84#define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1) 85#else 86#define IN_ADDR unsigned long 87#define NUMERIC_ADDR_ERROR (numeric_addr == -1) 88#endif 89 90#if defined(BSD_SYSTEM) || defined(STRIDE) 91#include <sys/ioctl.h> 92#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5) 93#include <fcntl.h> 94#endif /* HAVE_PTYS and no O_NDELAY */ 95#endif /* BSD_SYSTEM || STRIDE */ 96 97#ifdef BROKEN_O_NONBLOCK 98#undef O_NONBLOCK 99#endif /* BROKEN_O_NONBLOCK */ 100 101#ifdef NEED_BSDTTY 102#include <bsdtty.h> 103#endif 104 105/* Can we use SIOCGIFCONF and/or SIOCGIFADDR */ 106#ifdef HAVE_SOCKETS 107#if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H) 108/* sys/ioctl.h may have been included already */ 109#ifndef SIOCGIFADDR 110#include <sys/ioctl.h> 111#endif 112#include <net/if.h> 113#endif 114#endif 115 116#ifdef IRIS 117#include <sys/sysmacros.h> /* for "minor" */ 118#endif /* not IRIS */ 119 120#ifdef HAVE_SYS_WAIT 121#include <sys/wait.h> 122#endif 123 124/* Disable IPv6 support for w32 until someone figures out how to do it 125 properly. */ 126#ifdef WINDOWSNT 127# ifdef AF_INET6 128# undef AF_INET6 129# endif 130#endif 131 132#include "lisp.h" 133#include "systime.h" 134#include "systty.h" 135 136#include "window.h" 137#include "buffer.h" 138#include "charset.h" 139#include "coding.h" 140#include "process.h" 141#include "termhooks.h" 142#include "termopts.h" 143#include "commands.h" 144#include "keyboard.h" 145#include "frame.h" 146#include "blockinput.h" 147#include "dispextern.h" 148#include "composite.h" 149#include "atimer.h" 150 151Lisp_Object Qprocessp; 152Lisp_Object Qrun, Qstop, Qsignal; 153Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten; 154Lisp_Object Qlocal, Qipv4, Qdatagram; 155#ifdef AF_INET6 156Lisp_Object Qipv6; 157#endif 158Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype; 159Lisp_Object QClocal, QCremote, QCcoding; 160Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; 161Lisp_Object QCsentinel, QClog, QCoptions, QCplist; 162Lisp_Object QCfilter_multibyte; 163Lisp_Object Qlast_nonmenu_event; 164/* QCfamily is declared and initialized in xfaces.c, 165 QCfilter in keyboard.c. */ 166extern Lisp_Object QCfamily, QCfilter; 167 168/* Qexit is declared and initialized in eval.c. */ 169 170/* QCfamily is defined in xfaces.c. */ 171extern Lisp_Object QCfamily; 172/* QCfilter is defined in keyboard.c. */ 173extern Lisp_Object QCfilter; 174 175/* a process object is a network connection when its childp field is neither 176 Qt nor Qnil but is instead a property list (KEY VAL ...). */ 177 178#ifdef HAVE_SOCKETS 179#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp)) 180#define NETCONN1_P(p) (GC_CONSP ((p)->childp)) 181#else 182#define NETCONN_P(p) 0 183#define NETCONN1_P(p) 0 184#endif /* HAVE_SOCKETS */ 185 186/* Define first descriptor number available for subprocesses. */ 187#ifdef VMS 188#define FIRST_PROC_DESC 1 189#else /* Not VMS */ 190#define FIRST_PROC_DESC 3 191#endif 192 193/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals 194 testing SIGCHLD. */ 195 196#if !defined (SIGCHLD) && defined (SIGCLD) 197#define SIGCHLD SIGCLD 198#endif /* SIGCLD */ 199 200#include "syssignal.h" 201 202#include "syswait.h" 203 204extern char *get_operating_system_release (); 205 206#ifndef USE_CRT_DLL 207extern int errno; 208#endif 209#ifdef VMS 210extern char *sys_errlist[]; 211#endif 212 213#ifndef HAVE_H_ERRNO 214extern int h_errno; 215#endif 216 217/* t means use pty, nil means use a pipe, 218 maybe other values to come. */ 219static Lisp_Object Vprocess_connection_type; 220 221#ifdef SKTPAIR 222#ifndef HAVE_SOCKETS 223#include <sys/socket.h> 224#endif 225#endif /* SKTPAIR */ 226 227/* These next two vars are non-static since sysdep.c uses them in the 228 emulation of `select'. */ 229/* Number of events of change of status of a process. */ 230int process_tick; 231/* Number of events for which the user or sentinel has been notified. */ 232int update_tick; 233 234/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */ 235 236#ifdef BROKEN_NON_BLOCKING_CONNECT 237#undef NON_BLOCKING_CONNECT 238#else 239#ifndef NON_BLOCKING_CONNECT 240#ifdef HAVE_SOCKETS 241#ifdef HAVE_SELECT 242#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX) 243#if defined (O_NONBLOCK) || defined (O_NDELAY) 244#if defined (EWOULDBLOCK) || defined (EINPROGRESS) 245#define NON_BLOCKING_CONNECT 246#endif /* EWOULDBLOCK || EINPROGRESS */ 247#endif /* O_NONBLOCK || O_NDELAY */ 248#endif /* HAVE_GETPEERNAME || GNU_LINUX */ 249#endif /* HAVE_SELECT */ 250#endif /* HAVE_SOCKETS */ 251#endif /* NON_BLOCKING_CONNECT */ 252#endif /* BROKEN_NON_BLOCKING_CONNECT */ 253 254/* Define DATAGRAM_SOCKETS if datagrams can be used safely on 255 this system. We need to read full packets, so we need a 256 "non-destructive" select. So we require either native select, 257 or emulation of select using FIONREAD. */ 258 259#ifdef BROKEN_DATAGRAM_SOCKETS 260#undef DATAGRAM_SOCKETS 261#else 262#ifndef DATAGRAM_SOCKETS 263#ifdef HAVE_SOCKETS 264#if defined (HAVE_SELECT) || defined (FIONREAD) 265#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE) 266#define DATAGRAM_SOCKETS 267#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */ 268#endif /* HAVE_SELECT || FIONREAD */ 269#endif /* HAVE_SOCKETS */ 270#endif /* DATAGRAM_SOCKETS */ 271#endif /* BROKEN_DATAGRAM_SOCKETS */ 272 273#ifdef TERM 274#undef NON_BLOCKING_CONNECT 275#undef DATAGRAM_SOCKETS 276#endif 277 278#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING) 279#ifdef EMACS_HAS_USECS 280#define ADAPTIVE_READ_BUFFERING 281#endif 282#endif 283 284#ifdef ADAPTIVE_READ_BUFFERING 285#define READ_OUTPUT_DELAY_INCREMENT 10000 286#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5) 287#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7) 288 289/* Number of processes which have a non-zero read_output_delay, 290 and therefore might be delayed for adaptive read buffering. */ 291 292static int process_output_delay_count; 293 294/* Non-zero if any process has non-nil read_output_skip. */ 295 296static int process_output_skip; 297 298/* Non-nil means to delay reading process output to improve buffering. 299 A value of t means that delay is reset after each send, any other 300 non-nil value does not reset the delay. A value of nil disables 301 adaptive read buffering completely. */ 302static Lisp_Object Vprocess_adaptive_read_buffering; 303#else 304#define process_output_delay_count 0 305#endif 306 307 308#include "sysselect.h" 309 310static int keyboard_bit_set P_ ((SELECT_TYPE *)); 311static void deactivate_process P_ ((Lisp_Object)); 312static void status_notify P_ ((struct Lisp_Process *)); 313static int read_process_output P_ ((Lisp_Object, int)); 314 315/* If we support a window system, turn on the code to poll periodically 316 to detect C-g. It isn't actually used when doing interrupt input. */ 317#ifdef HAVE_WINDOW_SYSTEM 318#define POLL_FOR_INPUT 319#endif 320 321static Lisp_Object get_process (); 322static void exec_sentinel (); 323 324extern EMACS_TIME timer_check (); 325extern int timers_run; 326 327/* Mask of bits indicating the descriptors that we wait for input on. */ 328 329static SELECT_TYPE input_wait_mask; 330 331/* Mask that excludes keyboard input descriptor (s). */ 332 333static SELECT_TYPE non_keyboard_wait_mask; 334 335/* Mask that excludes process input descriptor (s). */ 336 337static SELECT_TYPE non_process_wait_mask; 338 339#ifdef NON_BLOCKING_CONNECT 340/* Mask of bits indicating the descriptors that we wait for connect to 341 complete on. Once they complete, they are removed from this mask 342 and added to the input_wait_mask and non_keyboard_wait_mask. */ 343 344static SELECT_TYPE connect_wait_mask; 345 346/* Number of bits set in connect_wait_mask. */ 347static int num_pending_connects; 348 349#define IF_NON_BLOCKING_CONNECT(s) s 350#else 351#define IF_NON_BLOCKING_CONNECT(s) 352#endif 353 354/* The largest descriptor currently in use for a process object. */ 355static int max_process_desc; 356 357/* The largest descriptor currently in use for keyboard input. */ 358static int max_keyboard_desc; 359 360/* Nonzero means delete a process right away if it exits. */ 361static int delete_exited_processes; 362 363/* Indexed by descriptor, gives the process (if any) for that descriptor */ 364Lisp_Object chan_process[MAXDESC]; 365 366/* Alist of elements (NAME . PROCESS) */ 367Lisp_Object Vprocess_alist; 368 369/* Buffered-ahead input char from process, indexed by channel. 370 -1 means empty (no char is buffered). 371 Used on sys V where the only way to tell if there is any 372 output from the process is to read at least one char. 373 Always -1 on systems that support FIONREAD. */ 374 375/* Don't make static; need to access externally. */ 376int proc_buffered_char[MAXDESC]; 377 378/* Table of `struct coding-system' for each process. */ 379static struct coding_system *proc_decode_coding_system[MAXDESC]; 380static struct coding_system *proc_encode_coding_system[MAXDESC]; 381 382#ifdef DATAGRAM_SOCKETS 383/* Table of `partner address' for datagram sockets. */ 384struct sockaddr_and_len { 385 struct sockaddr *sa; 386 int len; 387} datagram_address[MAXDESC]; 388#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0) 389#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0) 390#else 391#define DATAGRAM_CHAN_P(chan) (0) 392#define DATAGRAM_CONN_P(proc) (0) 393#endif 394 395/* Maximum number of bytes to send to a pty without an eof. */ 396static int pty_max_bytes; 397 398/* Nonzero means don't run process sentinels. This is used 399 when exiting. */ 400int inhibit_sentinels; 401 402#ifdef HAVE_PTYS 403#ifdef HAVE_PTY_H 404#include <pty.h> 405#endif 406/* The file name of the pty opened by allocate_pty. */ 407 408static char pty_name[24]; 409#endif 410 411/* Compute the Lisp form of the process status, p->status, from 412 the numeric status that was returned by `wait'. */ 413 414static Lisp_Object status_convert (); 415 416static void 417update_status (p) 418 struct Lisp_Process *p; 419{ 420 union { int i; WAITTYPE wt; } u; 421 eassert (p->raw_status_new); 422 u.i = p->raw_status; 423 p->status = status_convert (u.wt); 424 p->raw_status_new = 0; 425} 426 427/* Convert a process status word in Unix format to 428 the list that we use internally. */ 429 430static Lisp_Object 431status_convert (w) 432 WAITTYPE w; 433{ 434 if (WIFSTOPPED (w)) 435 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil)); 436 else if (WIFEXITED (w)) 437 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)), 438 WCOREDUMP (w) ? Qt : Qnil)); 439 else if (WIFSIGNALED (w)) 440 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)), 441 WCOREDUMP (w) ? Qt : Qnil)); 442 else 443 return Qrun; 444} 445 446/* Given a status-list, extract the three pieces of information 447 and store them individually through the three pointers. */ 448 449static void 450decode_status (l, symbol, code, coredump) 451 Lisp_Object l; 452 Lisp_Object *symbol; 453 int *code; 454 int *coredump; 455{ 456 Lisp_Object tem; 457 458 if (SYMBOLP (l)) 459 { 460 *symbol = l; 461 *code = 0; 462 *coredump = 0; 463 } 464 else 465 { 466 *symbol = XCAR (l); 467 tem = XCDR (l); 468 *code = XFASTINT (XCAR (tem)); 469 tem = XCDR (tem); 470 *coredump = !NILP (tem); 471 } 472} 473 474/* Return a string describing a process status list. */ 475 476static Lisp_Object 477status_message (p) 478 struct Lisp_Process *p; 479{ 480 Lisp_Object status = p->status; 481 Lisp_Object symbol; 482 int code, coredump; 483 Lisp_Object string, string2; 484 485 decode_status (status, &symbol, &code, &coredump); 486 487 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) 488 { 489 char *signame; 490 synchronize_system_messages_locale (); 491 signame = strsignal (code); 492 if (signame == 0) 493 signame = "unknown"; 494 string = build_string (signame); 495 string2 = build_string (coredump ? " (core dumped)\n" : "\n"); 496 SSET (string, 0, DOWNCASE (SREF (string, 0))); 497 return concat2 (string, string2); 498 } 499 else if (EQ (symbol, Qexit)) 500 { 501 if (NETCONN1_P (p)) 502 return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n"); 503 if (code == 0) 504 return build_string ("finished\n"); 505 string = Fnumber_to_string (make_number (code)); 506 string2 = build_string (coredump ? " (core dumped)\n" : "\n"); 507 return concat3 (build_string ("exited abnormally with code "), 508 string, string2); 509 } 510 else if (EQ (symbol, Qfailed)) 511 { 512 string = Fnumber_to_string (make_number (code)); 513 string2 = build_string ("\n"); 514 return concat3 (build_string ("failed with code "), 515 string, string2); 516 } 517 else 518 return Fcopy_sequence (Fsymbol_name (symbol)); 519} 520 521#ifdef HAVE_PTYS 522 523/* Open an available pty, returning a file descriptor. 524 Return -1 on failure. 525 The file name of the terminal corresponding to the pty 526 is left in the variable pty_name. */ 527 528static int 529allocate_pty () 530{ 531 register int c, i; 532 int fd; 533 534#ifdef PTY_ITERATION 535 PTY_ITERATION 536#else 537 for (c = FIRST_PTY_LETTER; c <= 'z'; c++) 538 for (i = 0; i < 16; i++) 539#endif 540 { 541 struct stat stb; /* Used in some PTY_OPEN. */ 542#ifdef PTY_NAME_SPRINTF 543 PTY_NAME_SPRINTF 544#else 545 sprintf (pty_name, "/dev/pty%c%x", c, i); 546#endif /* no PTY_NAME_SPRINTF */ 547 548#ifdef PTY_OPEN 549 PTY_OPEN; 550#else /* no PTY_OPEN */ 551 { 552# ifdef IRIS 553 /* Unusual IRIS code */ 554 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0); 555 if (fd < 0) 556 return -1; 557 if (fstat (fd, &stb) < 0) 558 return -1; 559# else /* not IRIS */ 560 { /* Some systems name their pseudoterminals so that there are gaps in 561 the usual sequence - for example, on HP9000/S700 systems, there 562 are no pseudoterminals with names ending in 'f'. So we wait for 563 three failures in a row before deciding that we've reached the 564 end of the ptys. */ 565 int failed_count = 0; 566 567 if (stat (pty_name, &stb) < 0) 568 { 569 failed_count++; 570 if (failed_count >= 3) 571 return -1; 572 } 573 else 574 failed_count = 0; 575 } 576# ifdef O_NONBLOCK 577 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0); 578# else 579 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0); 580# endif 581# endif /* not IRIS */ 582 } 583#endif /* no PTY_OPEN */ 584 585 if (fd >= 0) 586 { 587 /* check to make certain that both sides are available 588 this avoids a nasty yet stupid bug in rlogins */ 589#ifdef PTY_TTY_NAME_SPRINTF 590 PTY_TTY_NAME_SPRINTF 591#else 592 sprintf (pty_name, "/dev/tty%c%x", c, i); 593#endif /* no PTY_TTY_NAME_SPRINTF */ 594#ifndef UNIPLUS 595 if (access (pty_name, 6) != 0) 596 { 597 emacs_close (fd); 598# if !defined(IRIS) && !defined(__sgi) 599 continue; 600# else 601 return -1; 602# endif /* IRIS */ 603 } 604#endif /* not UNIPLUS */ 605 setup_pty (fd); 606 return fd; 607 } 608 } 609 return -1; 610} 611#endif /* HAVE_PTYS */ 612 613static Lisp_Object 614make_process (name) 615 Lisp_Object name; 616{ 617 register Lisp_Object val, tem, name1; 618 register struct Lisp_Process *p; 619 char suffix[10]; 620 register int i; 621 622 p = allocate_process (); 623 624 XSETINT (p->infd, -1); 625 XSETINT (p->outfd, -1); 626 XSETFASTINT (p->tick, 0); 627 XSETFASTINT (p->update_tick, 0); 628 p->pid = 0; 629 p->raw_status_new = 0; 630 p->status = Qrun; 631 p->mark = Fmake_marker (); 632 633#ifdef ADAPTIVE_READ_BUFFERING 634 p->adaptive_read_buffering = Qnil; 635 XSETFASTINT (p->read_output_delay, 0); 636 p->read_output_skip = Qnil; 637#endif 638 639 /* If name is already in use, modify it until it is unused. */ 640 641 name1 = name; 642 for (i = 1; ; i++) 643 { 644 tem = Fget_process (name1); 645 if (NILP (tem)) break; 646 sprintf (suffix, "<%d>", i); 647 name1 = concat2 (name, build_string (suffix)); 648 } 649 name = name1; 650 p->name = name; 651 XSETPROCESS (val, p); 652 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); 653 return val; 654} 655 656static void 657remove_process (proc) 658 register Lisp_Object proc; 659{ 660 register Lisp_Object pair; 661 662 pair = Frassq (proc, Vprocess_alist); 663 Vprocess_alist = Fdelq (pair, Vprocess_alist); 664 665 deactivate_process (proc); 666} 667 668/* Setup coding systems of PROCESS. */ 669 670void 671setup_process_coding_systems (process) 672 Lisp_Object process; 673{ 674 struct Lisp_Process *p = XPROCESS (process); 675 int inch = XINT (p->infd); 676 int outch = XINT (p->outfd); 677 678 if (inch < 0 || outch < 0) 679 return; 680 681 if (!proc_decode_coding_system[inch]) 682 proc_decode_coding_system[inch] 683 = (struct coding_system *) xmalloc (sizeof (struct coding_system)); 684 setup_coding_system (p->decode_coding_system, 685 proc_decode_coding_system[inch]); 686 if (! NILP (p->filter)) 687 { 688 if (NILP (p->filter_multibyte)) 689 setup_raw_text_coding_system (proc_decode_coding_system[inch]); 690 } 691 else if (BUFFERP (p->buffer)) 692 { 693 if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters)) 694 setup_raw_text_coding_system (proc_decode_coding_system[inch]); 695 } 696 697 if (!proc_encode_coding_system[outch]) 698 proc_encode_coding_system[outch] 699 = (struct coding_system *) xmalloc (sizeof (struct coding_system)); 700 setup_coding_system (p->encode_coding_system, 701 proc_encode_coding_system[outch]); 702 if (proc_encode_coding_system[outch]->eol_type == CODING_EOL_UNDECIDED) 703 proc_encode_coding_system[outch]->eol_type = system_eol_type; 704} 705 706DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, 707 doc: /* Return t if OBJECT is a process. */) 708 (object) 709 Lisp_Object object; 710{ 711 return PROCESSP (object) ? Qt : Qnil; 712} 713 714DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, 715 doc: /* Return the process named NAME, or nil if there is none. */) 716 (name) 717 register Lisp_Object name; 718{ 719 if (PROCESSP (name)) 720 return name; 721 CHECK_STRING (name); 722 return Fcdr (Fassoc (name, Vprocess_alist)); 723} 724 725DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, 726 doc: /* Return the (or a) process associated with BUFFER. 727BUFFER may be a buffer or the name of one. */) 728 (buffer) 729 register Lisp_Object buffer; 730{ 731 register Lisp_Object buf, tail, proc; 732 733 if (NILP (buffer)) return Qnil; 734 buf = Fget_buffer (buffer); 735 if (NILP (buf)) return Qnil; 736 737 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) 738 { 739 proc = Fcdr (Fcar (tail)); 740 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) 741 return proc; 742 } 743 return Qnil; 744} 745 746/* This is how commands for the user decode process arguments. It 747 accepts a process, a process name, a buffer, a buffer name, or nil. 748 Buffers denote the first process in the buffer, and nil denotes the 749 current buffer. */ 750 751static Lisp_Object 752get_process (name) 753 register Lisp_Object name; 754{ 755 register Lisp_Object proc, obj; 756 if (STRINGP (name)) 757 { 758 obj = Fget_process (name); 759 if (NILP (obj)) 760 obj = Fget_buffer (name); 761 if (NILP (obj)) 762 error ("Process %s does not exist", SDATA (name)); 763 } 764 else if (NILP (name)) 765 obj = Fcurrent_buffer (); 766 else 767 obj = name; 768 769 /* Now obj should be either a buffer object or a process object. 770 */ 771 if (BUFFERP (obj)) 772 { 773 proc = Fget_buffer_process (obj); 774 if (NILP (proc)) 775 error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name)); 776 } 777 else 778 { 779 CHECK_PROCESS (obj); 780 proc = obj; 781 } 782 return proc; 783} 784 785 786#ifdef SIGCHLD 787/* Fdelete_process promises to immediately forget about the process, but in 788 reality, Emacs needs to remember those processes until they have been 789 treated by sigchld_handler; otherwise this handler would consider the 790 process as being synchronous and say that the synchronous process is 791 dead. */ 792static Lisp_Object deleted_pid_list; 793#endif 794 795DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, 796 doc: /* Delete PROCESS: kill it and forget about it immediately. 797PROCESS may be a process, a buffer, the name of a process or buffer, or 798nil, indicating the current buffer's process. */) 799 (process) 800 register Lisp_Object process; 801{ 802 register struct Lisp_Process *p; 803 804 process = get_process (process); 805 p = XPROCESS (process); 806 807 p->raw_status_new = 0; 808 if (NETCONN1_P (p)) 809 { 810 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); 811 XSETINT (p->tick, ++process_tick); 812 status_notify (p); 813 } 814 else if (XINT (p->infd) >= 0) 815 { 816#ifdef SIGCHLD 817 Lisp_Object symbol; 818 /* Assignment to EMACS_INT stops GCC whining about limited range 819 of data type. */ 820 EMACS_INT pid = p->pid; 821 822 /* No problem storing the pid here, as it is still in Vprocess_alist. */ 823 deleted_pid_list = Fcons (make_fixnum_or_float (pid), 824 /* GC treated elements set to nil. */ 825 Fdelq (Qnil, deleted_pid_list)); 826 /* If the process has already signaled, remove it from the list. */ 827 if (p->raw_status_new) 828 update_status (p); 829 symbol = p->status; 830 if (CONSP (p->status)) 831 symbol = XCAR (p->status); 832 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) 833 deleted_pid_list 834 = Fdelete (make_fixnum_or_float (pid), deleted_pid_list); 835 else 836#endif 837 { 838 Fkill_process (process, Qnil); 839 /* Do this now, since remove_process will make sigchld_handler do nothing. */ 840 p->status 841 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); 842 XSETINT (p->tick, ++process_tick); 843 status_notify (p); 844 } 845 } 846 remove_process (process); 847 return Qnil; 848} 849 850DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, 851 doc: /* Return the status of PROCESS. 852The returned value is one of the following symbols: 853run -- for a process that is running. 854stop -- for a process stopped but continuable. 855exit -- for a process that has exited. 856signal -- for a process that has got a fatal signal. 857open -- for a network stream connection that is open. 858listen -- for a network stream server that is listening. 859closed -- for a network stream connection that is closed. 860connect -- when waiting for a non-blocking connection to complete. 861failed -- when a non-blocking connection has failed. 862nil -- if arg is a process name and no such process exists. 863PROCESS may be a process, a buffer, the name of a process, or 864nil, indicating the current buffer's process. */) 865 (process) 866 register Lisp_Object process; 867{ 868 register struct Lisp_Process *p; 869 register Lisp_Object status; 870 871 if (STRINGP (process)) 872 process = Fget_process (process); 873 else 874 process = get_process (process); 875 876 if (NILP (process)) 877 return process; 878 879 p = XPROCESS (process); 880 if (p->raw_status_new) 881 update_status (p); 882 status = p->status; 883 if (CONSP (status)) 884 status = XCAR (status); 885 if (NETCONN1_P (p)) 886 { 887 if (EQ (status, Qexit)) 888 status = Qclosed; 889 else if (EQ (p->command, Qt)) 890 status = Qstop; 891 else if (EQ (status, Qrun)) 892 status = Qopen; 893 } 894 return status; 895} 896 897DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 898 1, 1, 0, 899 doc: /* Return the exit status of PROCESS or the signal number that killed it. 900If PROCESS has not yet exited or died, return 0. */) 901 (process) 902 register Lisp_Object process; 903{ 904 CHECK_PROCESS (process); 905 if (XPROCESS (process)->raw_status_new) 906 update_status (XPROCESS (process)); 907 if (CONSP (XPROCESS (process)->status)) 908 return XCAR (XCDR (XPROCESS (process)->status)); 909 return make_number (0); 910} 911 912DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, 913 doc: /* Return the process id of PROCESS. 914This is the pid of the external process which PROCESS uses or talks to. 915For a network connection, this value is nil. */) 916 (process) 917 register Lisp_Object process; 918{ 919 /* Assignment to EMACS_INT stops GCC whining about limited range of 920 data type. */ 921 EMACS_INT pid; 922 923 CHECK_PROCESS (process); 924 pid = XPROCESS (process)->pid; 925 return (pid ? make_fixnum_or_float (pid) : Qnil); 926} 927 928DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, 929 doc: /* Return the name of PROCESS, as a string. 930This is the name of the program invoked in PROCESS, 931possibly modified to make it unique among process names. */) 932 (process) 933 register Lisp_Object process; 934{ 935 CHECK_PROCESS (process); 936 return XPROCESS (process)->name; 937} 938 939DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, 940 doc: /* Return the command that was executed to start PROCESS. 941This is a list of strings, the first string being the program executed 942and the rest of the strings being the arguments given to it. 943For a non-child channel, this is nil. */) 944 (process) 945 register Lisp_Object process; 946{ 947 CHECK_PROCESS (process); 948 return XPROCESS (process)->command; 949} 950 951DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, 952 doc: /* Return the name of the terminal PROCESS uses, or nil if none. 953This is the terminal that the process itself reads and writes on, 954not the name of the pty that Emacs uses to talk with that terminal. */) 955 (process) 956 register Lisp_Object process; 957{ 958 CHECK_PROCESS (process); 959 return XPROCESS (process)->tty_name; 960} 961 962DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 963 2, 2, 0, 964 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */) 965 (process, buffer) 966 register Lisp_Object process, buffer; 967{ 968 struct Lisp_Process *p; 969 970 CHECK_PROCESS (process); 971 if (!NILP (buffer)) 972 CHECK_BUFFER (buffer); 973 p = XPROCESS (process); 974 p->buffer = buffer; 975 if (NETCONN1_P (p)) 976 p->childp = Fplist_put (p->childp, QCbuffer, buffer); 977 setup_process_coding_systems (process); 978 return buffer; 979} 980 981DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, 982 1, 1, 0, 983 doc: /* Return the buffer PROCESS is associated with. 984Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */) 985 (process) 986 register Lisp_Object process; 987{ 988 CHECK_PROCESS (process); 989 return XPROCESS (process)->buffer; 990} 991 992DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, 993 1, 1, 0, 994 doc: /* Return the marker for the end of the last output from PROCESS. */) 995 (process) 996 register Lisp_Object process; 997{ 998 CHECK_PROCESS (process); 999 return XPROCESS (process)->mark; 1000} 1001 1002DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 1003 2, 2, 0, 1004 doc: /* Give PROCESS the filter function FILTER; nil means no filter. 1005t means stop accepting output from the process. 1006 1007When a process has a filter, its buffer is not used for output. 1008Instead, each time it does output, the entire string of output is 1009passed to the filter. 1010 1011The filter gets two arguments: the process and the string of output. 1012The string argument is normally a multibyte string, except: 1013- if the process' input coding system is no-conversion or raw-text, 1014 it is a unibyte string (the non-converted input), or else 1015- if `default-enable-multibyte-characters' is nil, it is a unibyte 1016 string (the result of converting the decoded input multibyte 1017 string to unibyte with `string-make-unibyte'). */) 1018 (process, filter) 1019 register Lisp_Object process, filter; 1020{ 1021 struct Lisp_Process *p; 1022 1023 CHECK_PROCESS (process); 1024 p = XPROCESS (process); 1025 1026 /* Don't signal an error if the process' input file descriptor 1027 is closed. This could make debugging Lisp more difficult, 1028 for example when doing something like 1029 1030 (setq process (start-process ...)) 1031 (debug) 1032 (set-process-filter process ...) */ 1033 1034 if (XINT (p->infd) >= 0) 1035 { 1036 if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) 1037 { 1038 FD_CLR (XINT (p->infd), &input_wait_mask); 1039 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 1040 } 1041 else if (EQ (p->filter, Qt) 1042 && !EQ (p->command, Qt)) /* Network process not stopped. */ 1043 { 1044 FD_SET (XINT (p->infd), &input_wait_mask); 1045 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 1046 } 1047 } 1048 1049 p->filter = filter; 1050 if (NETCONN1_P (p)) 1051 p->childp = Fplist_put (p->childp, QCfilter, filter); 1052 setup_process_coding_systems (process); 1053 return filter; 1054} 1055 1056DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, 1057 1, 1, 0, 1058 doc: /* Returns the filter function of PROCESS; nil if none. 1059See `set-process-filter' for more info on filter functions. */) 1060 (process) 1061 register Lisp_Object process; 1062{ 1063 CHECK_PROCESS (process); 1064 return XPROCESS (process)->filter; 1065} 1066 1067DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, 1068 2, 2, 0, 1069 doc: /* Give PROCESS the sentinel SENTINEL; nil for none. 1070The sentinel is called as a function when the process changes state. 1071It gets two arguments: the process, and a string describing the change. */) 1072 (process, sentinel) 1073 register Lisp_Object process, sentinel; 1074{ 1075 struct Lisp_Process *p; 1076 1077 CHECK_PROCESS (process); 1078 p = XPROCESS (process); 1079 1080 p->sentinel = sentinel; 1081 if (NETCONN1_P (p)) 1082 p->childp = Fplist_put (p->childp, QCsentinel, sentinel); 1083 return sentinel; 1084} 1085 1086DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, 1087 1, 1, 0, 1088 doc: /* Return the sentinel of PROCESS; nil if none. 1089See `set-process-sentinel' for more info on sentinels. */) 1090 (process) 1091 register Lisp_Object process; 1092{ 1093 CHECK_PROCESS (process); 1094 return XPROCESS (process)->sentinel; 1095} 1096 1097DEFUN ("set-process-window-size", Fset_process_window_size, 1098 Sset_process_window_size, 3, 3, 0, 1099 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */) 1100 (process, height, width) 1101 register Lisp_Object process, height, width; 1102{ 1103 CHECK_PROCESS (process); 1104 CHECK_NATNUM (height); 1105 CHECK_NATNUM (width); 1106 1107 if (XINT (XPROCESS (process)->infd) < 0 1108 || set_window_size (XINT (XPROCESS (process)->infd), 1109 XINT (height), XINT (width)) <= 0) 1110 return Qnil; 1111 else 1112 return Qt; 1113} 1114 1115DEFUN ("set-process-inherit-coding-system-flag", 1116 Fset_process_inherit_coding_system_flag, 1117 Sset_process_inherit_coding_system_flag, 2, 2, 0, 1118 doc: /* Determine whether buffer of PROCESS will inherit coding-system. 1119If the second argument FLAG is non-nil, then the variable 1120`buffer-file-coding-system' of the buffer associated with PROCESS 1121will be bound to the value of the coding system used to decode 1122the process output. 1123 1124This is useful when the coding system specified for the process buffer 1125leaves either the character code conversion or the end-of-line conversion 1126unspecified, or if the coding system used to decode the process output 1127is more appropriate for saving the process buffer. 1128 1129Binding the variable `inherit-process-coding-system' to non-nil before 1130starting the process is an alternative way of setting the inherit flag 1131for the process which will run. */) 1132 (process, flag) 1133 register Lisp_Object process, flag; 1134{ 1135 CHECK_PROCESS (process); 1136 XPROCESS (process)->inherit_coding_system_flag = flag; 1137 return flag; 1138} 1139 1140DEFUN ("process-inherit-coding-system-flag", 1141 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, 1142 1, 1, 0, 1143 doc: /* Return the value of inherit-coding-system flag for PROCESS. 1144If this flag is t, `buffer-file-coding-system' of the buffer 1145associated with PROCESS will inherit the coding system used to decode 1146the process output. */) 1147 (process) 1148 register Lisp_Object process; 1149{ 1150 CHECK_PROCESS (process); 1151 return XPROCESS (process)->inherit_coding_system_flag; 1152} 1153 1154DEFUN ("set-process-query-on-exit-flag", 1155 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag, 1156 2, 2, 0, 1157 doc: /* Specify if query is needed for PROCESS when Emacs is exited. 1158If the second argument FLAG is non-nil, Emacs will query the user before 1159exiting if PROCESS is running. */) 1160 (process, flag) 1161 register Lisp_Object process, flag; 1162{ 1163 CHECK_PROCESS (process); 1164 XPROCESS (process)->kill_without_query = Fnull (flag); 1165 return flag; 1166} 1167 1168DEFUN ("process-query-on-exit-flag", 1169 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag, 1170 1, 1, 0, 1171 doc: /* Return the current value of query-on-exit flag for PROCESS. */) 1172 (process) 1173 register Lisp_Object process; 1174{ 1175 CHECK_PROCESS (process); 1176 return Fnull (XPROCESS (process)->kill_without_query); 1177} 1178 1179#ifdef DATAGRAM_SOCKETS 1180Lisp_Object Fprocess_datagram_address (); 1181#endif 1182 1183DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 1184 1, 2, 0, 1185 doc: /* Return the contact info of PROCESS; t for a real child. 1186For a net connection, the value depends on the optional KEY arg. 1187If KEY is nil, value is a cons cell of the form (HOST SERVICE), 1188if KEY is t, the complete contact information for the connection is 1189returned, else the specific value for the keyword KEY is returned. 1190See `make-network-process' for a list of keywords. */) 1191 (process, key) 1192 register Lisp_Object process, key; 1193{ 1194 Lisp_Object contact; 1195 1196 CHECK_PROCESS (process); 1197 contact = XPROCESS (process)->childp; 1198 1199#ifdef DATAGRAM_SOCKETS 1200 if (DATAGRAM_CONN_P (process) 1201 && (EQ (key, Qt) || EQ (key, QCremote))) 1202 contact = Fplist_put (contact, QCremote, 1203 Fprocess_datagram_address (process)); 1204#endif 1205 1206 if (!NETCONN_P (process) || EQ (key, Qt)) 1207 return contact; 1208 if (NILP (key)) 1209 return Fcons (Fplist_get (contact, QChost), 1210 Fcons (Fplist_get (contact, QCservice), Qnil)); 1211 return Fplist_get (contact, key); 1212} 1213 1214DEFUN ("process-plist", Fprocess_plist, Sprocess_plist, 1215 1, 1, 0, 1216 doc: /* Return the plist of PROCESS. */) 1217 (process) 1218 register Lisp_Object process; 1219{ 1220 CHECK_PROCESS (process); 1221 return XPROCESS (process)->plist; 1222} 1223 1224DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist, 1225 2, 2, 0, 1226 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */) 1227 (process, plist) 1228 register Lisp_Object process, plist; 1229{ 1230 CHECK_PROCESS (process); 1231 CHECK_LIST (plist); 1232 1233 XPROCESS (process)->plist = plist; 1234 return plist; 1235} 1236 1237#if 0 /* Turned off because we don't currently record this info 1238 in the process. Perhaps add it. */ 1239DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0, 1240 doc: /* Return the connection type of PROCESS. 1241The value is nil for a pipe, t or `pty' for a pty, or `stream' for 1242a socket connection. */) 1243 (process) 1244 Lisp_Object process; 1245{ 1246 return XPROCESS (process)->type; 1247} 1248#endif 1249 1250#ifdef HAVE_SOCKETS 1251DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address, 1252 1, 2, 0, 1253 doc: /* Convert network ADDRESS from internal format to a string. 1254A 4 or 5 element vector represents an IPv4 address (with port number). 1255An 8 or 9 element vector represents an IPv6 address (with port number). 1256If optional second argument OMIT-PORT is non-nil, don't include a port 1257number in the string, even when present in ADDRESS. 1258Returns nil if format of ADDRESS is invalid. */) 1259 (address, omit_port) 1260 Lisp_Object address, omit_port; 1261{ 1262 if (NILP (address)) 1263 return Qnil; 1264 1265 if (STRINGP (address)) /* AF_LOCAL */ 1266 return address; 1267 1268 if (VECTORP (address)) /* AF_INET or AF_INET6 */ 1269 { 1270 register struct Lisp_Vector *p = XVECTOR (address); 1271 Lisp_Object args[10]; 1272 int nargs, i; 1273 1274 if (p->size == 4 || (p->size == 5 && !NILP (omit_port))) 1275 { 1276 args[0] = build_string ("%d.%d.%d.%d"); 1277 nargs = 4; 1278 } 1279 else if (p->size == 5) 1280 { 1281 args[0] = build_string ("%d.%d.%d.%d:%d"); 1282 nargs = 5; 1283 } 1284 else if (p->size == 8 || (p->size == 9 && !NILP (omit_port))) 1285 { 1286 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x"); 1287 nargs = 8; 1288 } 1289 else if (p->size == 9) 1290 { 1291 args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d"); 1292 nargs = 9; 1293 } 1294 else 1295 return Qnil; 1296 1297 for (i = 0; i < nargs; i++) 1298 { 1299 EMACS_INT element = XINT (p->contents[i]); 1300 1301 if (element < 0 || element > 65535) 1302 return Qnil; 1303 1304 if (nargs <= 5 /* IPv4 */ 1305 && i < 4 /* host, not port */ 1306 && element > 255) 1307 return Qnil; 1308 1309 args[i+1] = p->contents[i]; 1310 } 1311 1312 return Fformat (nargs+1, args); 1313 } 1314 1315 if (CONSP (address)) 1316 { 1317 Lisp_Object args[2]; 1318 args[0] = build_string ("<Family %d>"); 1319 args[1] = Fcar (address); 1320 return Fformat (2, args); 1321 } 1322 1323 return Qnil; 1324} 1325#endif 1326 1327static Lisp_Object 1328list_processes_1 (query_only) 1329 Lisp_Object query_only; 1330{ 1331 register Lisp_Object tail, tem; 1332 Lisp_Object proc, minspace, tem1; 1333 register struct Lisp_Process *p; 1334 char tembuf[300]; 1335 int w_proc, w_buffer, w_tty; 1336 int exited = 0; 1337 Lisp_Object i_status, i_buffer, i_tty, i_command; 1338 1339 w_proc = 4; /* Proc */ 1340 w_buffer = 6; /* Buffer */ 1341 w_tty = 0; /* Omit if no ttys */ 1342 1343 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) 1344 { 1345 int i; 1346 1347 proc = Fcdr (Fcar (tail)); 1348 p = XPROCESS (proc); 1349 if (NILP (p->childp)) 1350 continue; 1351 if (!NILP (query_only) && !NILP (p->kill_without_query)) 1352 continue; 1353 if (STRINGP (p->name) 1354 && ( i = SCHARS (p->name), (i > w_proc))) 1355 w_proc = i; 1356 if (!NILP (p->buffer)) 1357 { 1358 if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8) 1359 w_buffer = 8; /* (Killed) */ 1360 else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer))) 1361 w_buffer = i; 1362 } 1363 if (STRINGP (p->tty_name) 1364 && (i = SCHARS (p->tty_name), (i > w_tty))) 1365 w_tty = i; 1366 } 1367 1368 XSETFASTINT (i_status, w_proc + 1); 1369 XSETFASTINT (i_buffer, XFASTINT (i_status) + 9); 1370 if (w_tty) 1371 { 1372 XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1); 1373 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1); 1374 } else { 1375 i_tty = Qnil; 1376 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1); 1377 } 1378 1379 XSETFASTINT (minspace, 1); 1380 1381 set_buffer_internal (XBUFFER (Vstandard_output)); 1382 current_buffer->undo_list = Qt; 1383 1384 current_buffer->truncate_lines = Qt; 1385 1386 write_string ("Proc", -1); 1387 Findent_to (i_status, minspace); write_string ("Status", -1); 1388 Findent_to (i_buffer, minspace); write_string ("Buffer", -1); 1389 if (!NILP (i_tty)) 1390 { 1391 Findent_to (i_tty, minspace); write_string ("Tty", -1); 1392 } 1393 Findent_to (i_command, minspace); write_string ("Command", -1); 1394 write_string ("\n", -1); 1395 1396 write_string ("----", -1); 1397 Findent_to (i_status, minspace); write_string ("------", -1); 1398 Findent_to (i_buffer, minspace); write_string ("------", -1); 1399 if (!NILP (i_tty)) 1400 { 1401 Findent_to (i_tty, minspace); write_string ("---", -1); 1402 } 1403 Findent_to (i_command, minspace); write_string ("-------", -1); 1404 write_string ("\n", -1); 1405 1406 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) 1407 { 1408 Lisp_Object symbol; 1409 1410 proc = Fcdr (Fcar (tail)); 1411 p = XPROCESS (proc); 1412 if (NILP (p->childp)) 1413 continue; 1414 if (!NILP (query_only) && !NILP (p->kill_without_query)) 1415 continue; 1416 1417 Finsert (1, &p->name); 1418 Findent_to (i_status, minspace); 1419 1420 if (p->raw_status_new) 1421 update_status (p); 1422 symbol = p->status; 1423 if (CONSP (p->status)) 1424 symbol = XCAR (p->status); 1425 1426 if (EQ (symbol, Qsignal)) 1427 { 1428 Lisp_Object tem; 1429 tem = Fcar (Fcdr (p->status)); 1430#ifdef VMS 1431 if (XINT (tem) < NSIG) 1432 write_string (sys_errlist [XINT (tem)], -1); 1433 else 1434#endif 1435 Fprinc (symbol, Qnil); 1436 } 1437 else if (NETCONN1_P (p)) 1438 { 1439 if (EQ (symbol, Qexit)) 1440 write_string ("closed", -1); 1441 else if (EQ (p->command, Qt)) 1442 write_string ("stopped", -1); 1443 else if (EQ (symbol, Qrun)) 1444 write_string ("open", -1); 1445 else 1446 Fprinc (symbol, Qnil); 1447 } 1448 else 1449 Fprinc (symbol, Qnil); 1450 1451 if (EQ (symbol, Qexit)) 1452 { 1453 Lisp_Object tem; 1454 tem = Fcar (Fcdr (p->status)); 1455 if (XFASTINT (tem)) 1456 { 1457 sprintf (tembuf, " %d", (int) XFASTINT (tem)); 1458 write_string (tembuf, -1); 1459 } 1460 } 1461 1462 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed)) 1463 exited++; 1464 1465 Findent_to (i_buffer, minspace); 1466 if (NILP (p->buffer)) 1467 insert_string ("(none)"); 1468 else if (NILP (XBUFFER (p->buffer)->name)) 1469 insert_string ("(Killed)"); 1470 else 1471 Finsert (1, &XBUFFER (p->buffer)->name); 1472 1473 if (!NILP (i_tty)) 1474 { 1475 Findent_to (i_tty, minspace); 1476 if (STRINGP (p->tty_name)) 1477 Finsert (1, &p->tty_name); 1478 } 1479 1480 Findent_to (i_command, minspace); 1481 1482 if (EQ (p->status, Qlisten)) 1483 { 1484 Lisp_Object port = Fplist_get (p->childp, QCservice); 1485 if (INTEGERP (port)) 1486 port = Fnumber_to_string (port); 1487 if (NILP (port)) 1488 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil); 1489 sprintf (tembuf, "(network %s server on %s)\n", 1490 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), 1491 (STRINGP (port) ? (char *)SDATA (port) : "?")); 1492 insert_string (tembuf); 1493 } 1494 else if (NETCONN1_P (p)) 1495 { 1496 /* For a local socket, there is no host name, 1497 so display service instead. */ 1498 Lisp_Object host = Fplist_get (p->childp, QChost); 1499 if (!STRINGP (host)) 1500 { 1501 host = Fplist_get (p->childp, QCservice); 1502 if (INTEGERP (host)) 1503 host = Fnumber_to_string (host); 1504 } 1505 if (NILP (host)) 1506 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil); 1507 sprintf (tembuf, "(network %s connection to %s)\n", 1508 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), 1509 (STRINGP (host) ? (char *)SDATA (host) : "?")); 1510 insert_string (tembuf); 1511 } 1512 else 1513 { 1514 tem = p->command; 1515 while (1) 1516 { 1517 tem1 = Fcar (tem); 1518 Finsert (1, &tem1); 1519 tem = Fcdr (tem); 1520 if (NILP (tem)) 1521 break; 1522 insert_string (" "); 1523 } 1524 insert_string ("\n"); 1525 } 1526 } 1527 if (exited) 1528 status_notify (NULL); 1529 return Qnil; 1530} 1531 1532DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P", 1533 doc: /* Display a list of all processes. 1534If optional argument QUERY-ONLY is non-nil, only processes with 1535the query-on-exit flag set will be listed. 1536Any process listed as exited or signaled is actually eliminated 1537after the listing is made. */) 1538 (query_only) 1539 Lisp_Object query_only; 1540{ 1541 internal_with_output_to_temp_buffer ("*Process List*", 1542 list_processes_1, query_only); 1543 return Qnil; 1544} 1545 1546DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, 1547 doc: /* Return a list of all processes. */) 1548 () 1549{ 1550 return Fmapcar (Qcdr, Vprocess_alist); 1551} 1552 1553/* Starting asynchronous inferior processes. */ 1554 1555static Lisp_Object start_process_unwind (); 1556 1557DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, 1558 doc: /* Start a program in a subprocess. Return the process object for it. 1559NAME is name for process. It is modified if necessary to make it unique. 1560BUFFER is the buffer (or buffer name) to associate with the process. 1561 1562Process output (both standard output and standard error streams) goes 1563at end of BUFFER, unless you specify an output stream or filter 1564function to handle the output. BUFFER may also be nil, meaning that 1565this process is not associated with any buffer. 1566 1567PROGRAM is the program file name. It is searched for in PATH. 1568Remaining arguments are strings to give program as arguments. 1569 1570If you want to separate standard output from standard error, invoke 1571the command through a shell and redirect one of them using the shell 1572syntax. 1573 1574usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) 1575 (nargs, args) 1576 int nargs; 1577 register Lisp_Object *args; 1578{ 1579 Lisp_Object buffer, name, program, proc, current_dir, tem; 1580#ifdef VMS 1581 register unsigned char *new_argv; 1582 int len; 1583#else 1584 register unsigned char **new_argv; 1585#endif 1586 register int i; 1587 int count = SPECPDL_INDEX (); 1588 1589 buffer = args[1]; 1590 if (!NILP (buffer)) 1591 buffer = Fget_buffer_create (buffer); 1592 1593 /* Make sure that the child will be able to chdir to the current 1594 buffer's current directory, or its unhandled equivalent. We 1595 can't just have the child check for an error when it does the 1596 chdir, since it's in a vfork. 1597 1598 We have to GCPRO around this because Fexpand_file_name and 1599 Funhandled_file_name_directory might call a file name handling 1600 function. The argument list is protected by the caller, so all 1601 we really have to worry about is buffer. */ 1602 { 1603 struct gcpro gcpro1, gcpro2; 1604 1605 current_dir = current_buffer->directory; 1606 1607 GCPRO2 (buffer, current_dir); 1608 1609 current_dir 1610 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir), 1611 Qnil); 1612 if (NILP (Ffile_accessible_directory_p (current_dir))) 1613 report_file_error ("Setting current directory", 1614 Fcons (current_buffer->directory, Qnil)); 1615 1616 UNGCPRO; 1617 } 1618 1619 name = args[0]; 1620 CHECK_STRING (name); 1621 1622 program = args[2]; 1623 1624 CHECK_STRING (program); 1625 1626 proc = make_process (name); 1627 /* If an error occurs and we can't start the process, we want to 1628 remove it from the process list. This means that each error 1629 check in create_process doesn't need to call remove_process 1630 itself; it's all taken care of here. */ 1631 record_unwind_protect (start_process_unwind, proc); 1632 1633 XPROCESS (proc)->childp = Qt; 1634 XPROCESS (proc)->plist = Qnil; 1635 XPROCESS (proc)->buffer = buffer; 1636 XPROCESS (proc)->sentinel = Qnil; 1637 XPROCESS (proc)->filter = Qnil; 1638 XPROCESS (proc)->filter_multibyte 1639 = buffer_defaults.enable_multibyte_characters; 1640 XPROCESS (proc)->command = Flist (nargs - 2, args + 2); 1641 1642#ifdef ADAPTIVE_READ_BUFFERING 1643 XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering; 1644#endif 1645 1646 /* Make the process marker point into the process buffer (if any). */ 1647 if (BUFFERP (buffer)) 1648 set_marker_both (XPROCESS (proc)->mark, buffer, 1649 BUF_ZV (XBUFFER (buffer)), 1650 BUF_ZV_BYTE (XBUFFER (buffer))); 1651 1652 { 1653 /* Decide coding systems for communicating with the process. Here 1654 we don't setup the structure coding_system nor pay attention to 1655 unibyte mode. They are done in create_process. */ 1656 1657 /* Qt denotes we have not yet called Ffind_operation_coding_system. */ 1658 Lisp_Object coding_systems = Qt; 1659 Lisp_Object val, *args2; 1660 struct gcpro gcpro1, gcpro2; 1661 1662 val = Vcoding_system_for_read; 1663 if (NILP (val)) 1664 { 1665 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); 1666 args2[0] = Qstart_process; 1667 for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; 1668 GCPRO2 (proc, current_dir); 1669 coding_systems = Ffind_operation_coding_system (nargs + 1, args2); 1670 UNGCPRO; 1671 if (CONSP (coding_systems)) 1672 val = XCAR (coding_systems); 1673 else if (CONSP (Vdefault_process_coding_system)) 1674 val = XCAR (Vdefault_process_coding_system); 1675 } 1676 XPROCESS (proc)->decode_coding_system = val; 1677 1678 val = Vcoding_system_for_write; 1679 if (NILP (val)) 1680 { 1681 if (EQ (coding_systems, Qt)) 1682 { 1683 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2); 1684 args2[0] = Qstart_process; 1685 for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; 1686 GCPRO2 (proc, current_dir); 1687 coding_systems = Ffind_operation_coding_system (nargs + 1, args2); 1688 UNGCPRO; 1689 } 1690 if (CONSP (coding_systems)) 1691 val = XCDR (coding_systems); 1692 else if (CONSP (Vdefault_process_coding_system)) 1693 val = XCDR (Vdefault_process_coding_system); 1694 } 1695 XPROCESS (proc)->encode_coding_system = val; 1696 } 1697 1698#ifdef VMS 1699 /* Make a one member argv with all args concatenated 1700 together separated by a blank. */ 1701 len = SBYTES (program) + 2; 1702 for (i = 3; i < nargs; i++) 1703 { 1704 tem = args[i]; 1705 CHECK_STRING (tem); 1706 len += SBYTES (tem) + 1; /* count the blank */ 1707 } 1708 new_argv = (unsigned char *) alloca (len); 1709 strcpy (new_argv, SDATA (program)); 1710 for (i = 3; i < nargs; i++) 1711 { 1712 tem = args[i]; 1713 CHECK_STRING (tem); 1714 strcat (new_argv, " "); 1715 strcat (new_argv, SDATA (tem)); 1716 } 1717 /* Need to add code here to check for program existence on VMS */ 1718 1719#else /* not VMS */ 1720 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); 1721 1722 /* If program file name is not absolute, search our path for it. 1723 Put the name we will really use in TEM. */ 1724 if (!IS_DIRECTORY_SEP (SREF (program, 0)) 1725 && !(SCHARS (program) > 1 1726 && IS_DEVICE_SEP (SREF (program, 1)))) 1727 { 1728 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1729 1730 tem = Qnil; 1731 GCPRO4 (name, program, buffer, current_dir); 1732 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK)); 1733 UNGCPRO; 1734 if (NILP (tem)) 1735 report_file_error ("Searching for program", Fcons (program, Qnil)); 1736 tem = Fexpand_file_name (tem, Qnil); 1737 } 1738 else 1739 { 1740 if (!NILP (Ffile_directory_p (program))) 1741 error ("Specified program for new process is a directory"); 1742 tem = program; 1743 } 1744 1745 /* If program file name starts with /: for quoting a magic name, 1746 discard that. */ 1747 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/' 1748 && SREF (tem, 1) == ':') 1749 tem = Fsubstring (tem, make_number (2), Qnil); 1750 1751 /* Encode the file name and put it in NEW_ARGV. 1752 That's where the child will use it to execute the program. */ 1753 tem = ENCODE_FILE (tem); 1754 new_argv[0] = SDATA (tem); 1755 1756 /* Here we encode arguments by the coding system used for sending 1757 data to the process. We don't support using different coding 1758 systems for encoding arguments and for encoding data sent to the 1759 process. */ 1760 1761 for (i = 3; i < nargs; i++) 1762 { 1763 tem = args[i]; 1764 CHECK_STRING (tem); 1765 if (STRING_MULTIBYTE (tem)) 1766 tem = (code_convert_string_norecord 1767 (tem, XPROCESS (proc)->encode_coding_system, 1)); 1768 new_argv[i - 2] = SDATA (tem); 1769 } 1770 new_argv[i - 2] = 0; 1771#endif /* not VMS */ 1772 1773 XPROCESS (proc)->decoding_buf = make_uninit_string (0); 1774 XPROCESS (proc)->decoding_carryover = make_number (0); 1775 XPROCESS (proc)->encoding_buf = make_uninit_string (0); 1776 XPROCESS (proc)->encoding_carryover = make_number (0); 1777 1778 XPROCESS (proc)->inherit_coding_system_flag 1779 = (NILP (buffer) || !inherit_process_coding_system 1780 ? Qnil : Qt); 1781 1782 create_process (proc, (char **) new_argv, current_dir); 1783 1784 return unbind_to (count, proc); 1785} 1786 1787/* This function is the unwind_protect form for Fstart_process. If 1788 PROC doesn't have its pid set, then we know someone has signaled 1789 an error and the process wasn't started successfully, so we should 1790 remove it from the process list. */ 1791static Lisp_Object 1792start_process_unwind (proc) 1793 Lisp_Object proc; 1794{ 1795 if (!PROCESSP (proc)) 1796 abort (); 1797 1798 /* Was PROC started successfully? */ 1799 if (XPROCESS (proc)->pid <= 0) 1800 remove_process (proc); 1801 1802 return Qnil; 1803} 1804 1805static void 1806create_process_1 (timer) 1807 struct atimer *timer; 1808{ 1809 /* Nothing to do. */ 1810} 1811 1812 1813#if 0 /* This doesn't work; see the note before sigchld_handler. */ 1814#ifdef USG 1815#ifdef SIGCHLD 1816/* Mimic blocking of signals on system V, which doesn't really have it. */ 1817 1818/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */ 1819int sigchld_deferred; 1820 1821SIGTYPE 1822create_process_sigchld () 1823{ 1824 signal (SIGCHLD, create_process_sigchld); 1825 1826 sigchld_deferred = 1; 1827} 1828#endif 1829#endif 1830#endif 1831 1832#ifndef VMS /* VMS version of this function is in vmsproc.c. */ 1833void 1834create_process (process, new_argv, current_dir) 1835 Lisp_Object process; 1836 char **new_argv; 1837 Lisp_Object current_dir; 1838{ 1839 int inchannel, outchannel; 1840 pid_t pid; 1841 int sv[2]; 1842#ifdef POSIX_SIGNALS 1843 sigset_t procmask; 1844 sigset_t blocked; 1845 struct sigaction sigint_action; 1846 struct sigaction sigquit_action; 1847#ifdef AIX 1848 struct sigaction sighup_action; 1849#endif 1850#else /* !POSIX_SIGNALS */ 1851#if 0 1852#ifdef SIGCHLD 1853 SIGTYPE (*sigchld)(); 1854#endif 1855#endif /* 0 */ 1856#endif /* !POSIX_SIGNALS */ 1857 /* Use volatile to protect variables from being clobbered by longjmp. */ 1858 volatile int forkin, forkout; 1859 volatile int pty_flag = 0; 1860#ifndef USE_CRT_DLL 1861 extern char **environ; 1862#endif 1863 1864 inchannel = outchannel = -1; 1865 1866#ifdef HAVE_PTYS 1867 if (!NILP (Vprocess_connection_type)) 1868 outchannel = inchannel = allocate_pty (); 1869 1870 if (inchannel >= 0) 1871 { 1872#if ! defined (USG) || defined (USG_SUBTTY_WORKS) 1873 /* On most USG systems it does not work to open the pty's tty here, 1874 then close it and reopen it in the child. */ 1875#ifdef O_NOCTTY 1876 /* Don't let this terminal become our controlling terminal 1877 (in case we don't have one). */ 1878 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0); 1879#else 1880 forkout = forkin = emacs_open (pty_name, O_RDWR, 0); 1881#endif 1882 if (forkin < 0) 1883 report_file_error ("Opening pty", Qnil); 1884#if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY) 1885 /* In the case that vfork is defined as fork, the parent process 1886 (Emacs) may send some data before the child process completes 1887 tty options setup. So we setup tty before forking. */ 1888 child_setup_tty (forkout); 1889#endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */ 1890#else 1891 forkin = forkout = -1; 1892#endif /* not USG, or USG_SUBTTY_WORKS */ 1893 pty_flag = 1; 1894 } 1895 else 1896#endif /* HAVE_PTYS */ 1897#ifdef SKTPAIR 1898 { 1899 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0) 1900 report_file_error ("Opening socketpair", Qnil); 1901 outchannel = inchannel = sv[0]; 1902 forkout = forkin = sv[1]; 1903 } 1904#else /* not SKTPAIR */ 1905 { 1906 int tem; 1907 tem = pipe (sv); 1908 if (tem < 0) 1909 report_file_error ("Creating pipe", Qnil); 1910 inchannel = sv[0]; 1911 forkout = sv[1]; 1912 tem = pipe (sv); 1913 if (tem < 0) 1914 { 1915 emacs_close (inchannel); 1916 emacs_close (forkout); 1917 report_file_error ("Creating pipe", Qnil); 1918 } 1919 outchannel = sv[1]; 1920 forkin = sv[0]; 1921 } 1922#endif /* not SKTPAIR */ 1923 1924#if 0 1925 /* Replaced by close_process_descs */ 1926 set_exclusive_use (inchannel); 1927 set_exclusive_use (outchannel); 1928#endif 1929 1930/* Stride people say it's a mystery why this is needed 1931 as well as the O_NDELAY, but that it fails without this. */ 1932#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS)) 1933 { 1934 int one = 1; 1935 ioctl (inchannel, FIONBIO, &one); 1936 } 1937#endif 1938 1939#ifdef O_NONBLOCK 1940 fcntl (inchannel, F_SETFL, O_NONBLOCK); 1941 fcntl (outchannel, F_SETFL, O_NONBLOCK); 1942#else 1943#ifdef O_NDELAY 1944 fcntl (inchannel, F_SETFL, O_NDELAY); 1945 fcntl (outchannel, F_SETFL, O_NDELAY); 1946#endif 1947#endif 1948 1949 /* Record this as an active process, with its channels. 1950 As a result, child_setup will close Emacs's side of the pipes. */ 1951 chan_process[inchannel] = process; 1952 XSETINT (XPROCESS (process)->infd, inchannel); 1953 XSETINT (XPROCESS (process)->outfd, outchannel); 1954 1955 /* Previously we recorded the tty descriptor used in the subprocess. 1956 It was only used for getting the foreground tty process, so now 1957 we just reopen the device (see emacs_get_tty_pgrp) as this is 1958 more portable (see USG_SUBTTY_WORKS above). */ 1959 1960 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); 1961 XPROCESS (process)->status = Qrun; 1962 setup_process_coding_systems (process); 1963 1964 /* Delay interrupts until we have a chance to store 1965 the new fork's pid in its process structure */ 1966#ifdef POSIX_SIGNALS 1967 sigemptyset (&blocked); 1968#ifdef SIGCHLD 1969 sigaddset (&blocked, SIGCHLD); 1970#endif 1971#ifdef HAVE_WORKING_VFORK 1972 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal', 1973 this sets the parent's signal handlers as well as the child's. 1974 So delay all interrupts whose handlers the child might munge, 1975 and record the current handlers so they can be restored later. */ 1976 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action ); 1977 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action); 1978#ifdef AIX 1979 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action ); 1980#endif 1981#endif /* HAVE_WORKING_VFORK */ 1982 sigprocmask (SIG_BLOCK, &blocked, &procmask); 1983#else /* !POSIX_SIGNALS */ 1984#ifdef SIGCHLD 1985#ifdef BSD4_1 1986 sighold (SIGCHLD); 1987#else /* not BSD4_1 */ 1988#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX) 1989 sigsetmask (sigmask (SIGCHLD)); 1990#else /* ordinary USG */ 1991#if 0 1992 sigchld_deferred = 0; 1993 sigchld = signal (SIGCHLD, create_process_sigchld); 1994#endif 1995#endif /* ordinary USG */ 1996#endif /* not BSD4_1 */ 1997#endif /* SIGCHLD */ 1998#endif /* !POSIX_SIGNALS */ 1999 2000 FD_SET (inchannel, &input_wait_mask); 2001 FD_SET (inchannel, &non_keyboard_wait_mask); 2002 if (inchannel > max_process_desc) 2003 max_process_desc = inchannel; 2004 2005 /* Until we store the proper pid, enable sigchld_handler 2006 to recognize an unknown pid as standing for this process. 2007 It is very important not to let this `marker' value stay 2008 in the table after this function has returned; if it does 2009 it might cause call-process to hang and subsequent asynchronous 2010 processes to get their return values scrambled. */ 2011 XPROCESS (process)->pid = -1; 2012 2013 BLOCK_INPUT; 2014 2015 { 2016 /* child_setup must clobber environ on systems with true vfork. 2017 Protect it from permanent change. */ 2018 char **save_environ = environ; 2019 2020 current_dir = ENCODE_FILE (current_dir); 2021 2022#ifndef WINDOWSNT 2023 pid = vfork (); 2024 if (pid == 0) 2025#endif /* not WINDOWSNT */ 2026 { 2027 int xforkin = forkin; 2028 int xforkout = forkout; 2029 2030#if 0 /* This was probably a mistake--it duplicates code later on, 2031 but fails to handle all the cases. */ 2032 /* Make sure SIGCHLD is not blocked in the child. */ 2033 sigsetmask (SIGEMPTYMASK); 2034#endif 2035 2036 /* Make the pty be the controlling terminal of the process. */ 2037#ifdef HAVE_PTYS 2038 /* First, disconnect its current controlling terminal. */ 2039#ifdef HAVE_SETSID 2040 /* We tried doing setsid only if pty_flag, but it caused 2041 process_set_signal to fail on SGI when using a pipe. */ 2042 setsid (); 2043 /* Make the pty's terminal the controlling terminal. */ 2044 if (pty_flag) 2045 { 2046#ifdef TIOCSCTTY 2047 /* We ignore the return value 2048 because faith@cs.unc.edu says that is necessary on Linux. */ 2049 ioctl (xforkin, TIOCSCTTY, 0); 2050#endif 2051 } 2052#else /* not HAVE_SETSID */ 2053#ifdef USG 2054 /* It's very important to call setpgrp here and no time 2055 afterwards. Otherwise, we lose our controlling tty which 2056 is set when we open the pty. */ 2057 setpgrp (); 2058#endif /* USG */ 2059#endif /* not HAVE_SETSID */ 2060#if defined (HAVE_TERMIOS) && defined (LDISC1) 2061 if (pty_flag && xforkin >= 0) 2062 { 2063 struct termios t; 2064 tcgetattr (xforkin, &t); 2065 t.c_lflag = LDISC1; 2066 if (tcsetattr (xforkin, TCSANOW, &t) < 0) 2067 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39); 2068 } 2069#else 2070#if defined (NTTYDISC) && defined (TIOCSETD) 2071 if (pty_flag && xforkin >= 0) 2072 { 2073 /* Use new line discipline. */ 2074 int ldisc = NTTYDISC; 2075 ioctl (xforkin, TIOCSETD, &ldisc); 2076 } 2077#endif 2078#endif 2079#ifdef TIOCNOTTY 2080 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you 2081 can do TIOCSPGRP only to the process's controlling tty. */ 2082 if (pty_flag) 2083 { 2084 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? 2085 I can't test it since I don't have 4.3. */ 2086 int j = emacs_open ("/dev/tty", O_RDWR, 0); 2087 ioctl (j, TIOCNOTTY, 0); 2088 emacs_close (j); 2089#ifndef USG 2090 /* In order to get a controlling terminal on some versions 2091 of BSD, it is necessary to put the process in pgrp 0 2092 before it opens the terminal. */ 2093#ifdef HAVE_SETPGID 2094 setpgid (0, 0); 2095#else 2096 setpgrp (0, 0); 2097#endif 2098#endif 2099 } 2100#endif /* TIOCNOTTY */ 2101 2102#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY) 2103/*** There is a suggestion that this ought to be a 2104 conditional on TIOCSPGRP, 2105 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)). 2106 Trying the latter gave the wrong results on Debian GNU/Linux 1.1; 2107 that system does seem to need this code, even though 2108 both HAVE_SETSID and TIOCSCTTY are defined. */ 2109 /* Now close the pty (if we had it open) and reopen it. 2110 This makes the pty the controlling terminal of the subprocess. */ 2111 if (pty_flag) 2112 { 2113#ifdef SET_CHILD_PTY_PGRP 2114 int pgrp = getpid (); 2115#endif 2116 2117 /* I wonder if emacs_close (emacs_open (pty_name, ...)) 2118 would work? */ 2119 if (xforkin >= 0) 2120 emacs_close (xforkin); 2121 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0); 2122 2123 if (xforkin < 0) 2124 { 2125 emacs_write (1, "Couldn't open the pty terminal ", 31); 2126 emacs_write (1, pty_name, strlen (pty_name)); 2127 emacs_write (1, "\n", 1); 2128 _exit (1); 2129 } 2130 2131#ifdef SET_CHILD_PTY_PGRP 2132 ioctl (xforkin, TIOCSPGRP, &pgrp); 2133 ioctl (xforkout, TIOCSPGRP, &pgrp); 2134#endif 2135 } 2136#endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */ 2137 2138#ifdef SETUP_SLAVE_PTY 2139 if (pty_flag) 2140 { 2141 SETUP_SLAVE_PTY; 2142 } 2143#endif /* SETUP_SLAVE_PTY */ 2144#ifdef AIX 2145 /* On AIX, we've disabled SIGHUP above once we start a child on a pty. 2146 Now reenable it in the child, so it will die when we want it to. */ 2147 if (pty_flag) 2148 signal (SIGHUP, SIG_DFL); 2149#endif 2150#endif /* HAVE_PTYS */ 2151 2152 signal (SIGINT, SIG_DFL); 2153 signal (SIGQUIT, SIG_DFL); 2154 2155 /* Stop blocking signals in the child. */ 2156#ifdef POSIX_SIGNALS 2157 sigprocmask (SIG_SETMASK, &procmask, 0); 2158#else /* !POSIX_SIGNALS */ 2159#ifdef SIGCHLD 2160#ifdef BSD4_1 2161 sigrelse (SIGCHLD); 2162#else /* not BSD4_1 */ 2163#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX) 2164 sigsetmask (SIGEMPTYMASK); 2165#else /* ordinary USG */ 2166#if 0 2167 signal (SIGCHLD, sigchld); 2168#endif 2169#endif /* ordinary USG */ 2170#endif /* not BSD4_1 */ 2171#endif /* SIGCHLD */ 2172#endif /* !POSIX_SIGNALS */ 2173 2174#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY) 2175 if (pty_flag) 2176 child_setup_tty (xforkout); 2177#endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */ 2178#ifdef WINDOWSNT 2179 pid = child_setup (xforkin, xforkout, xforkout, 2180 new_argv, 1, current_dir); 2181#else /* not WINDOWSNT */ 2182 child_setup (xforkin, xforkout, xforkout, 2183 new_argv, 1, current_dir); 2184#endif /* not WINDOWSNT */ 2185 } 2186 environ = save_environ; 2187 } 2188 2189 UNBLOCK_INPUT; 2190 2191 /* This runs in the Emacs process. */ 2192 if (pid < 0) 2193 { 2194 if (forkin >= 0) 2195 emacs_close (forkin); 2196 if (forkin != forkout && forkout >= 0) 2197 emacs_close (forkout); 2198 } 2199 else 2200 { 2201 /* vfork succeeded. */ 2202 XPROCESS (process)->pid = pid; 2203 2204#ifdef WINDOWSNT 2205 register_child (pid, inchannel); 2206#endif /* WINDOWSNT */ 2207 2208 /* If the subfork execv fails, and it exits, 2209 this close hangs. I don't know why. 2210 So have an interrupt jar it loose. */ 2211 { 2212 struct atimer *timer; 2213 EMACS_TIME offset; 2214 2215 stop_polling (); 2216 EMACS_SET_SECS_USECS (offset, 1, 0); 2217 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0); 2218 2219 if (forkin >= 0) 2220 emacs_close (forkin); 2221 2222 cancel_atimer (timer); 2223 start_polling (); 2224 } 2225 2226 if (forkin != forkout && forkout >= 0) 2227 emacs_close (forkout); 2228 2229#ifdef HAVE_PTYS 2230 if (pty_flag) 2231 XPROCESS (process)->tty_name = build_string (pty_name); 2232 else 2233#endif 2234 XPROCESS (process)->tty_name = Qnil; 2235 } 2236 2237 /* Restore the signal state whether vfork succeeded or not. 2238 (We will signal an error, below, if it failed.) */ 2239#ifdef POSIX_SIGNALS 2240#ifdef HAVE_WORKING_VFORK 2241 /* Restore the parent's signal handlers. */ 2242 sigaction (SIGINT, &sigint_action, 0); 2243 sigaction (SIGQUIT, &sigquit_action, 0); 2244#ifdef AIX 2245 sigaction (SIGHUP, &sighup_action, 0); 2246#endif 2247#endif /* HAVE_WORKING_VFORK */ 2248 /* Stop blocking signals in the parent. */ 2249 sigprocmask (SIG_SETMASK, &procmask, 0); 2250#else /* !POSIX_SIGNALS */ 2251#ifdef SIGCHLD 2252#ifdef BSD4_1 2253 sigrelse (SIGCHLD); 2254#else /* not BSD4_1 */ 2255#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX) 2256 sigsetmask (SIGEMPTYMASK); 2257#else /* ordinary USG */ 2258#if 0 2259 signal (SIGCHLD, sigchld); 2260 /* Now really handle any of these signals 2261 that came in during this function. */ 2262 if (sigchld_deferred) 2263 kill (getpid (), SIGCHLD); 2264#endif 2265#endif /* ordinary USG */ 2266#endif /* not BSD4_1 */ 2267#endif /* SIGCHLD */ 2268#endif /* !POSIX_SIGNALS */ 2269 2270 /* Now generate the error if vfork failed. */ 2271 if (pid < 0) 2272 report_file_error ("Doing vfork", Qnil); 2273} 2274#endif /* not VMS */ 2275 2276 2277#ifdef HAVE_SOCKETS 2278 2279/* Convert an internal struct sockaddr to a lisp object (vector or string). 2280 The address family of sa is not included in the result. */ 2281 2282static Lisp_Object 2283conv_sockaddr_to_lisp (sa, len) 2284 struct sockaddr *sa; 2285 int len; 2286{ 2287 Lisp_Object address; 2288 int i; 2289 unsigned char *cp; 2290 register struct Lisp_Vector *p; 2291 2292 switch (sa->sa_family) 2293 { 2294 case AF_INET: 2295 { 2296 struct sockaddr_in *sin = (struct sockaddr_in *) sa; 2297 len = sizeof (sin->sin_addr) + 1; 2298 address = Fmake_vector (make_number (len), Qnil); 2299 p = XVECTOR (address); 2300 p->contents[--len] = make_number (ntohs (sin->sin_port)); 2301 cp = (unsigned char *)&sin->sin_addr; 2302 break; 2303 } 2304#ifdef AF_INET6 2305 case AF_INET6: 2306 { 2307 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa; 2308 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr; 2309 len = sizeof (sin6->sin6_addr)/2 + 1; 2310 address = Fmake_vector (make_number (len), Qnil); 2311 p = XVECTOR (address); 2312 p->contents[--len] = make_number (ntohs (sin6->sin6_port)); 2313 for (i = 0; i < len; i++) 2314 p->contents[i] = make_number (ntohs (ip6[i])); 2315 return address; 2316 } 2317#endif 2318#ifdef HAVE_LOCAL_SOCKETS 2319 case AF_LOCAL: 2320 { 2321 struct sockaddr_un *sockun = (struct sockaddr_un *) sa; 2322 for (i = 0; i < sizeof (sockun->sun_path); i++) 2323 if (sockun->sun_path[i] == 0) 2324 break; 2325 return make_unibyte_string (sockun->sun_path, i); 2326 } 2327#endif 2328 default: 2329 len -= sizeof (sa->sa_family); 2330 address = Fcons (make_number (sa->sa_family), 2331 Fmake_vector (make_number (len), Qnil)); 2332 p = XVECTOR (XCDR (address)); 2333 cp = (unsigned char *) sa + sizeof (sa->sa_family); 2334 break; 2335 } 2336 2337 i = 0; 2338 while (i < len) 2339 p->contents[i++] = make_number (*cp++); 2340 2341 return address; 2342} 2343 2344 2345/* Get family and required size for sockaddr structure to hold ADDRESS. */ 2346 2347static int 2348get_lisp_to_sockaddr_size (address, familyp) 2349 Lisp_Object address; 2350 int *familyp; 2351{ 2352 register struct Lisp_Vector *p; 2353 2354 if (VECTORP (address)) 2355 { 2356 p = XVECTOR (address); 2357 if (p->size == 5) 2358 { 2359 *familyp = AF_INET; 2360 return sizeof (struct sockaddr_in); 2361 } 2362#ifdef AF_INET6 2363 else if (p->size == 9) 2364 { 2365 *familyp = AF_INET6; 2366 return sizeof (struct sockaddr_in6); 2367 } 2368#endif 2369 } 2370#ifdef HAVE_LOCAL_SOCKETS 2371 else if (STRINGP (address)) 2372 { 2373 *familyp = AF_LOCAL; 2374 return sizeof (struct sockaddr_un); 2375 } 2376#endif 2377 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address))) 2378 { 2379 struct sockaddr *sa; 2380 *familyp = XINT (XCAR (address)); 2381 p = XVECTOR (XCDR (address)); 2382 return p->size + sizeof (sa->sa_family); 2383 } 2384 return 0; 2385} 2386 2387/* Convert an address object (vector or string) to an internal sockaddr. 2388 2389 The address format has been basically validated by 2390 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid; 2391 it could have come from user data. So if FAMILY is not valid, 2392 we return after zeroing *SA. */ 2393 2394static void 2395conv_lisp_to_sockaddr (family, address, sa, len) 2396 int family; 2397 Lisp_Object address; 2398 struct sockaddr *sa; 2399 int len; 2400{ 2401 register struct Lisp_Vector *p; 2402 register unsigned char *cp = NULL; 2403 register int i; 2404 2405 bzero (sa, len); 2406 2407 if (VECTORP (address)) 2408 { 2409 p = XVECTOR (address); 2410 if (family == AF_INET) 2411 { 2412 struct sockaddr_in *sin = (struct sockaddr_in *) sa; 2413 len = sizeof (sin->sin_addr) + 1; 2414 i = XINT (p->contents[--len]); 2415 sin->sin_port = htons (i); 2416 cp = (unsigned char *)&sin->sin_addr; 2417 sa->sa_family = family; 2418 } 2419#ifdef AF_INET6 2420 else if (family == AF_INET6) 2421 { 2422 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa; 2423 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr; 2424 len = sizeof (sin6->sin6_addr) + 1; 2425 i = XINT (p->contents[--len]); 2426 sin6->sin6_port = htons (i); 2427 for (i = 0; i < len; i++) 2428 if (INTEGERP (p->contents[i])) 2429 { 2430 int j = XFASTINT (p->contents[i]) & 0xffff; 2431 ip6[i] = ntohs (j); 2432 } 2433 sa->sa_family = family; 2434 } 2435#endif 2436 return; 2437 } 2438 else if (STRINGP (address)) 2439 { 2440#ifdef HAVE_LOCAL_SOCKETS 2441 if (family == AF_LOCAL) 2442 { 2443 struct sockaddr_un *sockun = (struct sockaddr_un *) sa; 2444 cp = SDATA (address); 2445 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++) 2446 sockun->sun_path[i] = *cp++; 2447 sa->sa_family = family; 2448 } 2449#endif 2450 return; 2451 } 2452 else 2453 { 2454 p = XVECTOR (XCDR (address)); 2455 cp = (unsigned char *)sa + sizeof (sa->sa_family); 2456 } 2457 2458 for (i = 0; i < len; i++) 2459 if (INTEGERP (p->contents[i])) 2460 *cp++ = XFASTINT (p->contents[i]) & 0xff; 2461} 2462 2463#ifdef DATAGRAM_SOCKETS 2464DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address, 2465 1, 1, 0, 2466 doc: /* Get the current datagram address associated with PROCESS. */) 2467 (process) 2468 Lisp_Object process; 2469{ 2470 int channel; 2471 2472 CHECK_PROCESS (process); 2473 2474 if (!DATAGRAM_CONN_P (process)) 2475 return Qnil; 2476 2477 channel = XINT (XPROCESS (process)->infd); 2478 return conv_sockaddr_to_lisp (datagram_address[channel].sa, 2479 datagram_address[channel].len); 2480} 2481 2482DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address, 2483 2, 2, 0, 2484 doc: /* Set the datagram address for PROCESS to ADDRESS. 2485Returns nil upon error setting address, ADDRESS otherwise. */) 2486 (process, address) 2487 Lisp_Object process, address; 2488{ 2489 int channel; 2490 int family, len; 2491 2492 CHECK_PROCESS (process); 2493 2494 if (!DATAGRAM_CONN_P (process)) 2495 return Qnil; 2496 2497 channel = XINT (XPROCESS (process)->infd); 2498 2499 len = get_lisp_to_sockaddr_size (address, &family); 2500 if (datagram_address[channel].len != len) 2501 return Qnil; 2502 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len); 2503 return address; 2504} 2505#endif 2506 2507 2508static struct socket_options { 2509 /* The name of this option. Should be lowercase version of option 2510 name without SO_ prefix. */ 2511 char *name; 2512 /* Option level SOL_... */ 2513 int optlevel; 2514 /* Option number SO_... */ 2515 int optnum; 2516 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype; 2517 enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit; 2518} socket_options[] = 2519 { 2520#ifdef SO_BINDTODEVICE 2521 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC }, 2522#endif 2523#ifdef SO_BROADCAST 2524 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC }, 2525#endif 2526#ifdef SO_DONTROUTE 2527 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC }, 2528#endif 2529#ifdef SO_KEEPALIVE 2530 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC }, 2531#endif 2532#ifdef SO_LINGER 2533 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC }, 2534#endif 2535#ifdef SO_OOBINLINE 2536 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC }, 2537#endif 2538#ifdef SO_PRIORITY 2539 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC }, 2540#endif 2541#ifdef SO_REUSEADDR 2542 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR }, 2543#endif 2544 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE } 2545 }; 2546 2547/* Set option OPT to value VAL on socket S. 2548 2549 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise. 2550 Signals an error if setting a known option fails. 2551*/ 2552 2553static int 2554set_socket_option (s, opt, val) 2555 int s; 2556 Lisp_Object opt, val; 2557{ 2558 char *name; 2559 struct socket_options *sopt; 2560 int ret = 0; 2561 2562 CHECK_SYMBOL (opt); 2563 2564 name = (char *) SDATA (SYMBOL_NAME (opt)); 2565 for (sopt = socket_options; sopt->name; sopt++) 2566 if (strcmp (name, sopt->name) == 0) 2567 break; 2568 2569 switch (sopt->opttype) 2570 { 2571 case SOPT_BOOL: 2572 { 2573 int optval; 2574 optval = NILP (val) ? 0 : 1; 2575 ret = setsockopt (s, sopt->optlevel, sopt->optnum, 2576 &optval, sizeof (optval)); 2577 break; 2578 } 2579 2580 case SOPT_INT: 2581 { 2582 int optval; 2583 if (INTEGERP (val)) 2584 optval = XINT (val); 2585 else 2586 error ("Bad option value for %s", name); 2587 ret = setsockopt (s, sopt->optlevel, sopt->optnum, 2588 &optval, sizeof (optval)); 2589 break; 2590 } 2591 2592#ifdef SO_BINDTODEVICE 2593 case SOPT_IFNAME: 2594 { 2595 char devname[IFNAMSIZ+1]; 2596 2597 /* This is broken, at least in the Linux 2.4 kernel. 2598 To unbind, the arg must be a zero integer, not the empty string. 2599 This should work on all systems. KFS. 2003-09-23. */ 2600 bzero (devname, sizeof devname); 2601 if (STRINGP (val)) 2602 { 2603 char *arg = (char *) SDATA (val); 2604 int len = min (strlen (arg), IFNAMSIZ); 2605 bcopy (arg, devname, len); 2606 } 2607 else if (!NILP (val)) 2608 error ("Bad option value for %s", name); 2609 ret = setsockopt (s, sopt->optlevel, sopt->optnum, 2610 devname, IFNAMSIZ); 2611 break; 2612 } 2613#endif 2614 2615#ifdef SO_LINGER 2616 case SOPT_LINGER: 2617 { 2618 struct linger linger; 2619 2620 linger.l_onoff = 1; 2621 linger.l_linger = 0; 2622 if (INTEGERP (val)) 2623 linger.l_linger = XINT (val); 2624 else 2625 linger.l_onoff = NILP (val) ? 0 : 1; 2626 ret = setsockopt (s, sopt->optlevel, sopt->optnum, 2627 &linger, sizeof (linger)); 2628 break; 2629 } 2630#endif 2631 2632 default: 2633 return 0; 2634 } 2635 2636 if (ret < 0) 2637 report_file_error ("Cannot set network option", 2638 Fcons (opt, Fcons (val, Qnil))); 2639 return (1 << sopt->optbit); 2640} 2641 2642 2643DEFUN ("set-network-process-option", 2644 Fset_network_process_option, Sset_network_process_option, 2645 3, 4, 0, 2646 doc: /* For network process PROCESS set option OPTION to value VALUE. 2647See `make-network-process' for a list of options and values. 2648If optional fourth arg NO-ERROR is non-nil, don't signal an error if 2649OPTION is not a supported option, return nil instead; otherwise return t. */) 2650 (process, option, value, no_error) 2651 Lisp_Object process, option, value; 2652 Lisp_Object no_error; 2653{ 2654 int s; 2655 struct Lisp_Process *p; 2656 2657 CHECK_PROCESS (process); 2658 p = XPROCESS (process); 2659 if (!NETCONN1_P (p)) 2660 error ("Process is not a network process"); 2661 2662 s = XINT (p->infd); 2663 if (s < 0) 2664 error ("Process is not running"); 2665 2666 if (set_socket_option (s, option, value)) 2667 { 2668 p->childp = Fplist_put (p->childp, option, value); 2669 return Qt; 2670 } 2671 2672 if (NILP (no_error)) 2673 error ("Unknown or unsupported option"); 2674 2675 return Qnil; 2676} 2677 2678 2679/* A version of request_sigio suitable for a record_unwind_protect. */ 2680 2681static Lisp_Object 2682unwind_request_sigio (dummy) 2683 Lisp_Object dummy; 2684{ 2685 if (interrupt_input) 2686 request_sigio (); 2687 return Qnil; 2688} 2689 2690/* Create a network stream/datagram client/server process. Treated 2691 exactly like a normal process when reading and writing. Primary 2692 differences are in status display and process deletion. A network 2693 connection has no PID; you cannot signal it. All you can do is 2694 stop/continue it and deactivate/close it via delete-process */ 2695 2696DEFUN ("make-network-process", Fmake_network_process, Smake_network_process, 2697 0, MANY, 0, 2698 doc: /* Create and return a network server or client process. 2699 2700In Emacs, network connections are represented by process objects, so 2701input and output work as for subprocesses and `delete-process' closes 2702a network connection. However, a network process has no process id, 2703it cannot be signaled, and the status codes are different from normal 2704processes. 2705 2706Arguments are specified as keyword/argument pairs. The following 2707arguments are defined: 2708 2709:name NAME -- NAME is name for process. It is modified if necessary 2710to make it unique. 2711 2712:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate 2713with the process. Process output goes at end of that buffer, unless 2714you specify an output stream or filter function to handle the output. 2715BUFFER may be also nil, meaning that this process is not associated 2716with any buffer. 2717 2718:host HOST -- HOST is name of the host to connect to, or its IP 2719address. The symbol `local' specifies the local host. If specified 2720for a server process, it must be a valid name or address for the local 2721host, and only clients connecting to that address will be accepted. 2722 2723:service SERVICE -- SERVICE is name of the service desired, or an 2724integer specifying a port number to connect to. If SERVICE is t, 2725a random port number is selected for the server. 2726 2727:type TYPE -- TYPE is the type of connection. The default (nil) is a 2728stream type connection, `datagram' creates a datagram type connection. 2729 2730:family FAMILY -- FAMILY is the address (and protocol) family for the 2731service specified by HOST and SERVICE. The default (nil) is to use 2732whatever address family (IPv4 or IPv6) that is defined for the host 2733and port number specified by HOST and SERVICE. Other address families 2734supported are: 2735 local -- for a local (i.e. UNIX) address specified by SERVICE. 2736 ipv4 -- use IPv4 address family only. 2737 ipv6 -- use IPv6 address family only. 2738 2739:local ADDRESS -- ADDRESS is the local address used for the connection. 2740This parameter is ignored when opening a client process. When specified 2741for a server process, the FAMILY, HOST and SERVICE args are ignored. 2742 2743:remote ADDRESS -- ADDRESS is the remote partner's address for the 2744connection. This parameter is ignored when opening a stream server 2745process. For a datagram server process, it specifies the initial 2746setting of the remote datagram address. When specified for a client 2747process, the FAMILY, HOST, and SERVICE args are ignored. 2748 2749The format of ADDRESS depends on the address family: 2750- An IPv4 address is represented as an vector of integers [A B C D P] 2751corresponding to numeric IP address A.B.C.D and port number P. 2752- A local address is represented as a string with the address in the 2753local address space. 2754- An "unsupported family" address is represented by a cons (F . AV) 2755where F is the family number and AV is a vector containing the socket 2756address data with one element per address data byte. Do not rely on 2757this format in portable code, as it may depend on implementation 2758defined constants, data sizes, and data structure alignment. 2759 2760:coding CODING -- If CODING is a symbol, it specifies the coding 2761system used for both reading and writing for this process. If CODING 2762is a cons (DECODING . ENCODING), DECODING is used for reading, and 2763ENCODING is used for writing. 2764 2765:nowait BOOL -- If BOOL is non-nil for a stream type client process, 2766return without waiting for the connection to complete; instead, the 2767sentinel function will be called with second arg matching "open" (if 2768successful) or "failed" when the connect completes. Default is to use 2769a blocking connect (i.e. wait) for stream type connections. 2770 2771:noquery BOOL -- Query the user unless BOOL is non-nil, and process is 2772running when Emacs is exited. 2773 2774:stop BOOL -- Start process in the `stopped' state if BOOL non-nil. 2775In the stopped state, a server process does not accept new 2776connections, and a client process does not handle incoming traffic. 2777The stopped state is cleared by `continue-process' and set by 2778`stop-process'. 2779 2780:filter FILTER -- Install FILTER as the process filter. 2781 2782:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the 2783process filter are multibyte, otherwise they are unibyte. 2784If this keyword is not specified, the strings are multibyte iff 2785`default-enable-multibyte-characters' is non-nil. 2786 2787:sentinel SENTINEL -- Install SENTINEL as the process sentinel. 2788 2789:log LOG -- Install LOG as the server process log function. This 2790function is called when the server accepts a network connection from a 2791client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER 2792is the server process, CLIENT is the new process for the connection, 2793and MESSAGE is a string. 2794 2795:plist PLIST -- Install PLIST as the new process' initial plist. 2796 2797:server QLEN -- if QLEN is non-nil, create a server process for the 2798specified FAMILY, SERVICE, and connection type (stream or datagram). 2799If QLEN is an integer, it is used as the max. length of the server's 2800pending connection queue (also known as the backlog); the default 2801queue length is 5. Default is to create a client process. 2802 2803The following network options can be specified for this connection: 2804 2805:broadcast BOOL -- Allow send and receive of datagram broadcasts. 2806:dontroute BOOL -- Only send to directly connected hosts. 2807:keepalive BOOL -- Send keep-alive messages on network stream. 2808:linger BOOL or TIMEOUT -- Send queued messages before closing. 2809:oobinline BOOL -- Place out-of-band data in receive data stream. 2810:priority INT -- Set protocol defined priority for sent packets. 2811:reuseaddr BOOL -- Allow reusing a recently used local address 2812 (this is allowed by default for a server process). 2813:bindtodevice NAME -- bind to interface NAME. Using this may require 2814 special privileges on some systems. 2815 2816Consult the relevant system programmer's manual pages for more 2817information on using these options. 2818 2819 2820A server process will listen for and accept connections from clients. 2821When a client connection is accepted, a new network process is created 2822for the connection with the following parameters: 2823 2824- The client's process name is constructed by concatenating the server 2825process' NAME and a client identification string. 2826- If the FILTER argument is non-nil, the client process will not get a 2827separate process buffer; otherwise, the client's process buffer is a newly 2828created buffer named after the server process' BUFFER name or process 2829NAME concatenated with the client identification string. 2830- The connection type and the process filter and sentinel parameters are 2831inherited from the server process' TYPE, FILTER and SENTINEL. 2832- The client process' contact info is set according to the client's 2833addressing information (typically an IP address and a port number). 2834- The client process' plist is initialized from the server's plist. 2835 2836Notice that the FILTER and SENTINEL args are never used directly by 2837the server process. Also, the BUFFER argument is not used directly by 2838the server process, but via the optional :log function, accepted (and 2839failed) connections may be logged in the server process' buffer. 2840 2841The original argument list, modified with the actual connection 2842information, is available via the `process-contact' function. 2843 2844usage: (make-network-process &rest ARGS) */) 2845 (nargs, args) 2846 int nargs; 2847 Lisp_Object *args; 2848{ 2849 Lisp_Object proc; 2850 Lisp_Object contact; 2851 struct Lisp_Process *p; 2852#ifdef HAVE_GETADDRINFO 2853 struct addrinfo ai, *res, *lres; 2854 struct addrinfo hints; 2855 char *portstring, portbuf[128]; 2856#else /* HAVE_GETADDRINFO */ 2857 struct _emacs_addrinfo 2858 { 2859 int ai_family; 2860 int ai_socktype; 2861 int ai_protocol; 2862 int ai_addrlen; 2863 struct sockaddr *ai_addr; 2864 struct _emacs_addrinfo *ai_next; 2865 } ai, *res, *lres; 2866#endif /* HAVE_GETADDRINFO */ 2867 struct sockaddr_in address_in; 2868#ifdef HAVE_LOCAL_SOCKETS 2869 struct sockaddr_un address_un; 2870#endif 2871 int port; 2872 int ret = 0; 2873 int xerrno = 0; 2874 int s = -1, outch, inch; 2875 struct gcpro gcpro1; 2876 int count = SPECPDL_INDEX (); 2877 int count1; 2878 Lisp_Object QCaddress; /* one of QClocal or QCremote */ 2879 Lisp_Object tem; 2880 Lisp_Object name, buffer, host, service, address; 2881 Lisp_Object filter, sentinel; 2882 int is_non_blocking_client = 0; 2883 int is_server = 0, backlog = 5; 2884 int socktype; 2885 int family = -1; 2886 2887 if (nargs == 0) 2888 return Qnil; 2889 2890 /* Save arguments for process-contact and clone-process. */ 2891 contact = Flist (nargs, args); 2892 GCPRO1 (contact); 2893 2894#ifdef WINDOWSNT 2895 /* Ensure socket support is loaded if available. */ 2896 init_winsock (TRUE); 2897#endif 2898 2899 /* :type TYPE (nil: stream, datagram */ 2900 tem = Fplist_get (contact, QCtype); 2901 if (NILP (tem)) 2902 socktype = SOCK_STREAM; 2903#ifdef DATAGRAM_SOCKETS 2904 else if (EQ (tem, Qdatagram)) 2905 socktype = SOCK_DGRAM; 2906#endif 2907 else 2908 error ("Unsupported connection type"); 2909 2910 /* :server BOOL */ 2911 tem = Fplist_get (contact, QCserver); 2912 if (!NILP (tem)) 2913 { 2914 /* Don't support network sockets when non-blocking mode is 2915 not available, since a blocked Emacs is not useful. */ 2916#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY)) 2917 error ("Network servers not supported"); 2918#else 2919 is_server = 1; 2920 if (INTEGERP (tem)) 2921 backlog = XINT (tem); 2922#endif 2923 } 2924 2925 /* Make QCaddress an alias for :local (server) or :remote (client). */ 2926 QCaddress = is_server ? QClocal : QCremote; 2927 2928 /* :nowait BOOL */ 2929 if (!is_server && socktype == SOCK_STREAM 2930 && (tem = Fplist_get (contact, QCnowait), !NILP (tem))) 2931 { 2932#ifndef NON_BLOCKING_CONNECT 2933 error ("Non-blocking connect not supported"); 2934#else 2935 is_non_blocking_client = 1; 2936#endif 2937 } 2938 2939 name = Fplist_get (contact, QCname); 2940 buffer = Fplist_get (contact, QCbuffer); 2941 filter = Fplist_get (contact, QCfilter); 2942 sentinel = Fplist_get (contact, QCsentinel); 2943 2944 CHECK_STRING (name); 2945 2946#ifdef TERM 2947 /* Let's handle TERM before things get complicated ... */ 2948 host = Fplist_get (contact, QChost); 2949 CHECK_STRING (host); 2950 2951 service = Fplist_get (contact, QCservice); 2952 if (INTEGERP (service)) 2953 port = htons ((unsigned short) XINT (service)); 2954 else 2955 { 2956 struct servent *svc_info; 2957 CHECK_STRING (service); 2958 svc_info = getservbyname (SDATA (service), "tcp"); 2959 if (svc_info == 0) 2960 error ("Unknown service: %s", SDATA (service)); 2961 port = svc_info->s_port; 2962 } 2963 2964 s = connect_server (0); 2965 if (s < 0) 2966 report_file_error ("error creating socket", Fcons (name, Qnil)); 2967 send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port)); 2968 send_command (s, C_DUMB, 1, 0); 2969 2970#else /* not TERM */ 2971 2972 /* Initialize addrinfo structure in case we don't use getaddrinfo. */ 2973 ai.ai_socktype = socktype; 2974 ai.ai_protocol = 0; 2975 ai.ai_next = NULL; 2976 res = &ai; 2977 2978 /* :local ADDRESS or :remote ADDRESS */ 2979 address = Fplist_get (contact, QCaddress); 2980 if (!NILP (address)) 2981 { 2982 host = service = Qnil; 2983 2984 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family))) 2985 error ("Malformed :address"); 2986 ai.ai_family = family; 2987 ai.ai_addr = alloca (ai.ai_addrlen); 2988 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen); 2989 goto open_socket; 2990 } 2991 2992 /* :family FAMILY -- nil (for Inet), local, or integer. */ 2993 tem = Fplist_get (contact, QCfamily); 2994 if (NILP (tem)) 2995 { 2996#if defined(HAVE_GETADDRINFO) && defined(AF_INET6) 2997 family = AF_UNSPEC; 2998#else 2999 family = AF_INET; 3000#endif 3001 } 3002#ifdef HAVE_LOCAL_SOCKETS 3003 else if (EQ (tem, Qlocal)) 3004 family = AF_LOCAL; 3005#endif 3006#ifdef AF_INET6 3007 else if (EQ (tem, Qipv6)) 3008 family = AF_INET6; 3009#endif 3010 else if (EQ (tem, Qipv4)) 3011 family = AF_INET; 3012 else if (INTEGERP (tem)) 3013 family = XINT (tem); 3014 else 3015 error ("Unknown address family"); 3016 3017 ai.ai_family = family; 3018 3019 /* :service SERVICE -- string, integer (port number), or t (random port). */ 3020 service = Fplist_get (contact, QCservice); 3021 3022#ifdef HAVE_LOCAL_SOCKETS 3023 if (family == AF_LOCAL) 3024 { 3025 /* Host is not used. */ 3026 host = Qnil; 3027 CHECK_STRING (service); 3028 bzero (&address_un, sizeof address_un); 3029 address_un.sun_family = AF_LOCAL; 3030 strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path); 3031 ai.ai_addr = (struct sockaddr *) &address_un; 3032 ai.ai_addrlen = sizeof address_un; 3033 goto open_socket; 3034 } 3035#endif 3036 3037 /* :host HOST -- hostname, ip address, or 'local for localhost. */ 3038 host = Fplist_get (contact, QChost); 3039 if (!NILP (host)) 3040 { 3041 if (EQ (host, Qlocal)) 3042 host = build_string ("localhost"); 3043 CHECK_STRING (host); 3044 } 3045 3046 /* Slow down polling to every ten seconds. 3047 Some kernels have a bug which causes retrying connect to fail 3048 after a connect. Polling can interfere with gethostbyname too. */ 3049#ifdef POLL_FOR_INPUT 3050 if (socktype == SOCK_STREAM) 3051 { 3052 record_unwind_protect (unwind_stop_other_atimers, Qnil); 3053 bind_polling_period (10); 3054 } 3055#endif 3056 3057#ifdef HAVE_GETADDRINFO 3058 /* If we have a host, use getaddrinfo to resolve both host and service. 3059 Otherwise, use getservbyname to lookup the service. */ 3060 if (!NILP (host)) 3061 { 3062 3063 /* SERVICE can either be a string or int. 3064 Convert to a C string for later use by getaddrinfo. */ 3065 if (EQ (service, Qt)) 3066 portstring = "0"; 3067 else if (INTEGERP (service)) 3068 { 3069 sprintf (portbuf, "%ld", (long) XINT (service)); 3070 portstring = portbuf; 3071 } 3072 else 3073 { 3074 CHECK_STRING (service); 3075 portstring = SDATA (service); 3076 } 3077 3078 immediate_quit = 1; 3079 QUIT; 3080 memset (&hints, 0, sizeof (hints)); 3081 hints.ai_flags = 0; 3082 hints.ai_family = family; 3083 hints.ai_socktype = socktype; 3084 hints.ai_protocol = 0; 3085 ret = getaddrinfo (SDATA (host), portstring, &hints, &res); 3086 if (ret) 3087#ifdef HAVE_GAI_STRERROR 3088 error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret)); 3089#else 3090 error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret); 3091#endif 3092 immediate_quit = 0; 3093 3094 goto open_socket; 3095 } 3096#endif /* HAVE_GETADDRINFO */ 3097 3098 /* We end up here if getaddrinfo is not defined, or in case no hostname 3099 has been specified (e.g. for a local server process). */ 3100 3101 if (EQ (service, Qt)) 3102 port = 0; 3103 else if (INTEGERP (service)) 3104 port = htons ((unsigned short) XINT (service)); 3105 else 3106 { 3107 struct servent *svc_info; 3108 CHECK_STRING (service); 3109 svc_info = getservbyname (SDATA (service), 3110 (socktype == SOCK_DGRAM ? "udp" : "tcp")); 3111 if (svc_info == 0) 3112 error ("Unknown service: %s", SDATA (service)); 3113 port = svc_info->s_port; 3114 } 3115 3116 bzero (&address_in, sizeof address_in); 3117 address_in.sin_family = family; 3118 address_in.sin_addr.s_addr = INADDR_ANY; 3119 address_in.sin_port = port; 3120 3121#ifndef HAVE_GETADDRINFO 3122 if (!NILP (host)) 3123 { 3124 struct hostent *host_info_ptr; 3125 3126 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that, 3127 as it may `hang' Emacs for a very long time. */ 3128 immediate_quit = 1; 3129 QUIT; 3130 host_info_ptr = gethostbyname (SDATA (host)); 3131 immediate_quit = 0; 3132 3133 if (host_info_ptr) 3134 { 3135 bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr, 3136 host_info_ptr->h_length); 3137 family = host_info_ptr->h_addrtype; 3138 address_in.sin_family = family; 3139 } 3140 else 3141 /* Attempt to interpret host as numeric inet address */ 3142 { 3143 IN_ADDR numeric_addr; 3144 numeric_addr = inet_addr ((char *) SDATA (host)); 3145 if (NUMERIC_ADDR_ERROR) 3146 error ("Unknown host \"%s\"", SDATA (host)); 3147 3148 bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr, 3149 sizeof (address_in.sin_addr)); 3150 } 3151 3152 } 3153#endif /* not HAVE_GETADDRINFO */ 3154 3155 ai.ai_family = family; 3156 ai.ai_addr = (struct sockaddr *) &address_in; 3157 ai.ai_addrlen = sizeof address_in; 3158 3159 open_socket: 3160 3161 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) 3162 when connect is interrupted. So let's not let it get interrupted. 3163 Note we do not turn off polling, because polling is only used 3164 when not interrupt_input, and thus not normally used on the systems 3165 which have this bug. On systems which use polling, there's no way 3166 to quit if polling is turned off. */ 3167 if (interrupt_input 3168 && !is_server && socktype == SOCK_STREAM) 3169 { 3170 /* Comment from KFS: The original open-network-stream code 3171 didn't unwind protect this, but it seems like the proper 3172 thing to do. In any case, I don't see how it could harm to 3173 do this -- and it makes cleanup (using unbind_to) easier. */ 3174 record_unwind_protect (unwind_request_sigio, Qnil); 3175 unrequest_sigio (); 3176 } 3177 3178 /* Do this in case we never enter the for-loop below. */ 3179 count1 = SPECPDL_INDEX (); 3180 s = -1; 3181 3182 for (lres = res; lres; lres = lres->ai_next) 3183 { 3184 int optn, optbits; 3185 3186 retry_connect: 3187 3188 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol); 3189 if (s < 0) 3190 { 3191 xerrno = errno; 3192 continue; 3193 } 3194 3195#ifdef DATAGRAM_SOCKETS 3196 if (!is_server && socktype == SOCK_DGRAM) 3197 break; 3198#endif /* DATAGRAM_SOCKETS */ 3199 3200#ifdef NON_BLOCKING_CONNECT 3201 if (is_non_blocking_client) 3202 { 3203#ifdef O_NONBLOCK 3204 ret = fcntl (s, F_SETFL, O_NONBLOCK); 3205#else 3206 ret = fcntl (s, F_SETFL, O_NDELAY); 3207#endif 3208 if (ret < 0) 3209 { 3210 xerrno = errno; 3211 emacs_close (s); 3212 s = -1; 3213 continue; 3214 } 3215 } 3216#endif 3217 3218 /* Make us close S if quit. */ 3219 record_unwind_protect (close_file_unwind, make_number (s)); 3220 3221 /* Parse network options in the arg list. 3222 We simply ignore anything which isn't a known option (including other keywords). 3223 An error is signalled if setting a known option fails. */ 3224 for (optn = optbits = 0; optn < nargs-1; optn += 2) 3225 optbits |= set_socket_option (s, args[optn], args[optn+1]); 3226 3227 if (is_server) 3228 { 3229 /* Configure as a server socket. */ 3230 3231 /* SO_REUSEADDR = 1 is default for server sockets; must specify 3232 explicit :reuseaddr key to override this. */ 3233#ifdef HAVE_LOCAL_SOCKETS 3234 if (family != AF_LOCAL) 3235#endif 3236 if (!(optbits & (1 << OPIX_REUSEADDR))) 3237 { 3238 int optval = 1; 3239 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval)) 3240 report_file_error ("Cannot set reuse option on server socket", Qnil); 3241 } 3242 3243 if (bind (s, lres->ai_addr, lres->ai_addrlen)) 3244 report_file_error ("Cannot bind server socket", Qnil); 3245 3246#ifdef HAVE_GETSOCKNAME 3247 if (EQ (service, Qt)) 3248 { 3249 struct sockaddr_in sa1; 3250 int len1 = sizeof (sa1); 3251 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0) 3252 { 3253 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port; 3254 service = make_number (ntohs (sa1.sin_port)); 3255 contact = Fplist_put (contact, QCservice, service); 3256 } 3257 } 3258#endif 3259 3260 if (socktype == SOCK_STREAM && listen (s, backlog)) 3261 report_file_error ("Cannot listen on server socket", Qnil); 3262 3263 break; 3264 } 3265 3266 immediate_quit = 1; 3267 QUIT; 3268 3269 /* This turns off all alarm-based interrupts; the 3270 bind_polling_period call above doesn't always turn all the 3271 short-interval ones off, especially if interrupt_input is 3272 set. 3273 3274 It'd be nice to be able to control the connect timeout 3275 though. Would non-blocking connect calls be portable? 3276 3277 This used to be conditioned by HAVE_GETADDRINFO. Why? */ 3278 3279 turn_on_atimers (0); 3280 3281 ret = connect (s, lres->ai_addr, lres->ai_addrlen); 3282 xerrno = errno; 3283 3284 turn_on_atimers (1); 3285 3286 if (ret == 0 || xerrno == EISCONN) 3287 { 3288 /* The unwind-protect will be discarded afterwards. 3289 Likewise for immediate_quit. */ 3290 break; 3291 } 3292 3293#ifdef NON_BLOCKING_CONNECT 3294#ifdef EINPROGRESS 3295 if (is_non_blocking_client && xerrno == EINPROGRESS) 3296 break; 3297#else 3298#ifdef EWOULDBLOCK 3299 if (is_non_blocking_client && xerrno == EWOULDBLOCK) 3300 break; 3301#endif 3302#endif 3303#endif 3304 3305 immediate_quit = 0; 3306 3307 /* Discard the unwind protect closing S. */ 3308 specpdl_ptr = specpdl + count1; 3309 emacs_close (s); 3310 s = -1; 3311 3312 if (xerrno == EINTR) 3313 goto retry_connect; 3314 } 3315 3316 if (s >= 0) 3317 { 3318#ifdef DATAGRAM_SOCKETS 3319 if (socktype == SOCK_DGRAM) 3320 { 3321 if (datagram_address[s].sa) 3322 abort (); 3323 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen); 3324 datagram_address[s].len = lres->ai_addrlen; 3325 if (is_server) 3326 { 3327 Lisp_Object remote; 3328 bzero (datagram_address[s].sa, lres->ai_addrlen); 3329 if (remote = Fplist_get (contact, QCremote), !NILP (remote)) 3330 { 3331 int rfamily, rlen; 3332 rlen = get_lisp_to_sockaddr_size (remote, &rfamily); 3333 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen) 3334 conv_lisp_to_sockaddr (rfamily, remote, 3335 datagram_address[s].sa, rlen); 3336 } 3337 } 3338 else 3339 bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen); 3340 } 3341#endif 3342 contact = Fplist_put (contact, QCaddress, 3343 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen)); 3344#ifdef HAVE_GETSOCKNAME 3345 if (!is_server) 3346 { 3347 struct sockaddr_in sa1; 3348 int len1 = sizeof (sa1); 3349 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0) 3350 contact = Fplist_put (contact, QClocal, 3351 conv_sockaddr_to_lisp (&sa1, len1)); 3352 } 3353#endif 3354 } 3355 3356 immediate_quit = 0; 3357 3358#ifdef HAVE_GETADDRINFO 3359 if (res != &ai) 3360 { 3361 BLOCK_INPUT; 3362 freeaddrinfo (res); 3363 UNBLOCK_INPUT; 3364 } 3365#endif 3366 3367 /* Discard the unwind protect for closing S, if any. */ 3368 specpdl_ptr = specpdl + count1; 3369 3370 /* Unwind bind_polling_period and request_sigio. */ 3371 unbind_to (count, Qnil); 3372 3373 if (s < 0) 3374 { 3375 /* If non-blocking got this far - and failed - assume non-blocking is 3376 not supported after all. This is probably a wrong assumption, but 3377 the normal blocking calls to open-network-stream handles this error 3378 better. */ 3379 if (is_non_blocking_client) 3380 return Qnil; 3381 3382 errno = xerrno; 3383 if (is_server) 3384 report_file_error ("make server process failed", contact); 3385 else 3386 report_file_error ("make client process failed", contact); 3387 } 3388 3389#endif /* not TERM */ 3390 3391 inch = s; 3392 outch = s; 3393 3394 if (!NILP (buffer)) 3395 buffer = Fget_buffer_create (buffer); 3396 proc = make_process (name); 3397 3398 chan_process[inch] = proc; 3399 3400#ifdef O_NONBLOCK 3401 fcntl (inch, F_SETFL, O_NONBLOCK); 3402#else 3403#ifdef O_NDELAY 3404 fcntl (inch, F_SETFL, O_NDELAY); 3405#endif 3406#endif 3407 3408 p = XPROCESS (proc); 3409 3410 p->childp = contact; 3411 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist)); 3412 3413 p->buffer = buffer; 3414 p->sentinel = sentinel; 3415 p->filter = filter; 3416 p->filter_multibyte = buffer_defaults.enable_multibyte_characters; 3417 /* Override the above only if :filter-multibyte is specified. */ 3418 if (! NILP (Fplist_member (contact, QCfilter_multibyte))) 3419 p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte); 3420 p->log = Fplist_get (contact, QClog); 3421 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) 3422 p->kill_without_query = Qt; 3423 if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) 3424 p->command = Qt; 3425 p->pid = 0; 3426 XSETINT (p->infd, inch); 3427 XSETINT (p->outfd, outch); 3428 if (is_server && socktype == SOCK_STREAM) 3429 p->status = Qlisten; 3430 3431 /* Make the process marker point into the process buffer (if any). */ 3432 if (BUFFERP (buffer)) 3433 set_marker_both (p->mark, buffer, 3434 BUF_ZV (XBUFFER (buffer)), 3435 BUF_ZV_BYTE (XBUFFER (buffer))); 3436 3437#ifdef NON_BLOCKING_CONNECT 3438 if (is_non_blocking_client) 3439 { 3440 /* We may get here if connect did succeed immediately. However, 3441 in that case, we still need to signal this like a non-blocking 3442 connection. */ 3443 p->status = Qconnect; 3444 if (!FD_ISSET (inch, &connect_wait_mask)) 3445 { 3446 FD_SET (inch, &connect_wait_mask); 3447 num_pending_connects++; 3448 } 3449 } 3450 else 3451#endif 3452 /* A server may have a client filter setting of Qt, but it must 3453 still listen for incoming connects unless it is stopped. */ 3454 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt)) 3455 || (EQ (p->status, Qlisten) && NILP (p->command))) 3456 { 3457 FD_SET (inch, &input_wait_mask); 3458 FD_SET (inch, &non_keyboard_wait_mask); 3459 } 3460 3461 if (inch > max_process_desc) 3462 max_process_desc = inch; 3463 3464 tem = Fplist_member (contact, QCcoding); 3465 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) 3466 tem = Qnil; /* No error message (too late!). */ 3467 3468 { 3469 /* Setup coding systems for communicating with the network stream. */ 3470 struct gcpro gcpro1; 3471 /* Qt denotes we have not yet called Ffind_operation_coding_system. */ 3472 Lisp_Object coding_systems = Qt; 3473 Lisp_Object args[5], val; 3474 3475 if (!NILP (tem)) 3476 { 3477 val = XCAR (XCDR (tem)); 3478 if (CONSP (val)) 3479 val = XCAR (val); 3480 } 3481 else if (!NILP (Vcoding_system_for_read)) 3482 val = Vcoding_system_for_read; 3483 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) 3484 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) 3485 /* We dare not decode end-of-line format by setting VAL to 3486 Qraw_text, because the existing Emacs Lisp libraries 3487 assume that they receive bare code including a sequene of 3488 CR LF. */ 3489 val = Qnil; 3490 else 3491 { 3492 if (NILP (host) || NILP (service)) 3493 coding_systems = Qnil; 3494 else 3495 { 3496 args[0] = Qopen_network_stream, args[1] = name, 3497 args[2] = buffer, args[3] = host, args[4] = service; 3498 GCPRO1 (proc); 3499 coding_systems = Ffind_operation_coding_system (5, args); 3500 UNGCPRO; 3501 } 3502 if (CONSP (coding_systems)) 3503 val = XCAR (coding_systems); 3504 else if (CONSP (Vdefault_process_coding_system)) 3505 val = XCAR (Vdefault_process_coding_system); 3506 else 3507 val = Qnil; 3508 } 3509 p->decode_coding_system = val; 3510 3511 if (!NILP (tem)) 3512 { 3513 val = XCAR (XCDR (tem)); 3514 if (CONSP (val)) 3515 val = XCDR (val); 3516 } 3517 else if (!NILP (Vcoding_system_for_write)) 3518 val = Vcoding_system_for_write; 3519 else if (NILP (current_buffer->enable_multibyte_characters)) 3520 val = Qnil; 3521 else 3522 { 3523 if (EQ (coding_systems, Qt)) 3524 { 3525 if (NILP (host) || NILP (service)) 3526 coding_systems = Qnil; 3527 else 3528 { 3529 args[0] = Qopen_network_stream, args[1] = name, 3530 args[2] = buffer, args[3] = host, args[4] = service; 3531 GCPRO1 (proc); 3532 coding_systems = Ffind_operation_coding_system (5, args); 3533 UNGCPRO; 3534 } 3535 } 3536 if (CONSP (coding_systems)) 3537 val = XCDR (coding_systems); 3538 else if (CONSP (Vdefault_process_coding_system)) 3539 val = XCDR (Vdefault_process_coding_system); 3540 else 3541 val = Qnil; 3542 } 3543 p->encode_coding_system = val; 3544 } 3545 setup_process_coding_systems (proc); 3546 3547 p->decoding_buf = make_uninit_string (0); 3548 p->decoding_carryover = make_number (0); 3549 p->encoding_buf = make_uninit_string (0); 3550 p->encoding_carryover = make_number (0); 3551 3552 p->inherit_coding_system_flag 3553 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system 3554 ? Qnil : Qt); 3555 3556 UNGCPRO; 3557 return proc; 3558} 3559#endif /* HAVE_SOCKETS */ 3560 3561 3562#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) 3563 3564#ifdef SIOCGIFCONF 3565DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0, 3566 doc: /* Return an alist of all network interfaces and their network address. 3567Each element is a cons, the car of which is a string containing the 3568interface name, and the cdr is the network address in internal 3569format; see the description of ADDRESS in `make-network-process'. */) 3570 () 3571{ 3572 struct ifconf ifconf; 3573 struct ifreq *ifreqs = NULL; 3574 int ifaces = 0; 3575 int buf_size, s; 3576 Lisp_Object res; 3577 3578 s = socket (AF_INET, SOCK_STREAM, 0); 3579 if (s < 0) 3580 return Qnil; 3581 3582 again: 3583 ifaces += 25; 3584 buf_size = ifaces * sizeof(ifreqs[0]); 3585 ifreqs = (struct ifreq *)xrealloc(ifreqs, buf_size); 3586 if (!ifreqs) 3587 { 3588 close (s); 3589 return Qnil; 3590 } 3591 3592 ifconf.ifc_len = buf_size; 3593 ifconf.ifc_req = ifreqs; 3594 if (ioctl (s, SIOCGIFCONF, &ifconf)) 3595 { 3596 close (s); 3597 return Qnil; 3598 } 3599 3600 if (ifconf.ifc_len == buf_size) 3601 goto again; 3602 3603 close (s); 3604 ifaces = ifconf.ifc_len / sizeof (ifreqs[0]); 3605 3606 res = Qnil; 3607 while (--ifaces >= 0) 3608 { 3609 struct ifreq *ifq = &ifreqs[ifaces]; 3610 char namebuf[sizeof (ifq->ifr_name) + 1]; 3611 if (ifq->ifr_addr.sa_family != AF_INET) 3612 continue; 3613 bcopy (ifq->ifr_name, namebuf, sizeof (ifq->ifr_name)); 3614 namebuf[sizeof (ifq->ifr_name)] = 0; 3615 res = Fcons (Fcons (build_string (namebuf), 3616 conv_sockaddr_to_lisp (&ifq->ifr_addr, 3617 sizeof (struct sockaddr))), 3618 res); 3619 } 3620 3621 return res; 3622} 3623#endif /* SIOCGIFCONF */ 3624 3625#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS) 3626 3627struct ifflag_def { 3628 int flag_bit; 3629 char *flag_sym; 3630}; 3631 3632static struct ifflag_def ifflag_table[] = { 3633#ifdef IFF_UP 3634 { IFF_UP, "up" }, 3635#endif 3636#ifdef IFF_BROADCAST 3637 { IFF_BROADCAST, "broadcast" }, 3638#endif 3639#ifdef IFF_DEBUG 3640 { IFF_DEBUG, "debug" }, 3641#endif 3642#ifdef IFF_LOOPBACK 3643 { IFF_LOOPBACK, "loopback" }, 3644#endif 3645#ifdef IFF_POINTOPOINT 3646 { IFF_POINTOPOINT, "pointopoint" }, 3647#endif 3648#ifdef IFF_RUNNING 3649 { IFF_RUNNING, "running" }, 3650#endif 3651#ifdef IFF_NOARP 3652 { IFF_NOARP, "noarp" }, 3653#endif 3654#ifdef IFF_PROMISC 3655 { IFF_PROMISC, "promisc" }, 3656#endif 3657#ifdef IFF_NOTRAILERS 3658 { IFF_NOTRAILERS, "notrailers" }, 3659#endif 3660#ifdef IFF_ALLMULTI 3661 { IFF_ALLMULTI, "allmulti" }, 3662#endif 3663#ifdef IFF_MASTER 3664 { IFF_MASTER, "master" }, 3665#endif 3666#ifdef IFF_SLAVE 3667 { IFF_SLAVE, "slave" }, 3668#endif 3669#ifdef IFF_MULTICAST 3670 { IFF_MULTICAST, "multicast" }, 3671#endif 3672#ifdef IFF_PORTSEL 3673 { IFF_PORTSEL, "portsel" }, 3674#endif 3675#ifdef IFF_AUTOMEDIA 3676 { IFF_AUTOMEDIA, "automedia" }, 3677#endif 3678#ifdef IFF_DYNAMIC 3679 { IFF_DYNAMIC, "dynamic" }, 3680#endif 3681#ifdef IFF_OACTIVE 3682 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress */ 3683#endif 3684#ifdef IFF_SIMPLEX 3685 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions */ 3686#endif 3687#ifdef IFF_LINK0 3688 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit */ 3689#endif 3690#ifdef IFF_LINK1 3691 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit */ 3692#endif 3693#ifdef IFF_LINK2 3694 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit */ 3695#endif 3696 { 0, 0 } 3697}; 3698 3699DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0, 3700 doc: /* Return information about network interface named IFNAME. 3701The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS), 3702where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address, 3703NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and 3704FLAGS is the current flags of the interface. */) 3705 (ifname) 3706 Lisp_Object ifname; 3707{ 3708 struct ifreq rq; 3709 Lisp_Object res = Qnil; 3710 Lisp_Object elt; 3711 int s; 3712 int any = 0; 3713 3714 CHECK_STRING (ifname); 3715 3716 bzero (rq.ifr_name, sizeof rq.ifr_name); 3717 strncpy (rq.ifr_name, SDATA (ifname), sizeof (rq.ifr_name)); 3718 3719 s = socket (AF_INET, SOCK_STREAM, 0); 3720 if (s < 0) 3721 return Qnil; 3722 3723 elt = Qnil; 3724#if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS) 3725 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0) 3726 { 3727 int flags = rq.ifr_flags; 3728 struct ifflag_def *fp; 3729 int fnum; 3730 3731 any++; 3732 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++) 3733 { 3734 if (flags & fp->flag_bit) 3735 { 3736 elt = Fcons (intern (fp->flag_sym), elt); 3737 flags -= fp->flag_bit; 3738 } 3739 } 3740 for (fnum = 0; flags && fnum < 32; fnum++) 3741 { 3742 if (flags & (1 << fnum)) 3743 { 3744 elt = Fcons (make_number (fnum), elt); 3745 } 3746 } 3747 } 3748#endif 3749 res = Fcons (elt, res); 3750 3751 elt = Qnil; 3752#if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR) 3753 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0) 3754 { 3755 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil); 3756 register struct Lisp_Vector *p = XVECTOR (hwaddr); 3757 int n; 3758 3759 any++; 3760 for (n = 0; n < 6; n++) 3761 p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]); 3762 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr); 3763 } 3764#endif 3765 res = Fcons (elt, res); 3766 3767 elt = Qnil; 3768#if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR)) 3769 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0) 3770 { 3771 any++; 3772#ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK 3773 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask)); 3774#else 3775 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr)); 3776#endif 3777 } 3778#endif 3779 res = Fcons (elt, res); 3780 3781 elt = Qnil; 3782#if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR) 3783 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0) 3784 { 3785 any++; 3786 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr)); 3787 } 3788#endif 3789 res = Fcons (elt, res); 3790 3791 elt = Qnil; 3792#if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR) 3793 if (ioctl (s, SIOCGIFADDR, &rq) == 0) 3794 { 3795 any++; 3796 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr)); 3797 } 3798#endif 3799 res = Fcons (elt, res); 3800 3801 close (s); 3802 3803 return any ? res : Qnil; 3804} 3805#endif 3806#endif /* HAVE_SOCKETS */ 3807 3808/* Turn off input and output for process PROC. */ 3809 3810void 3811deactivate_process (proc) 3812 Lisp_Object proc; 3813{ 3814 register int inchannel, outchannel; 3815 register struct Lisp_Process *p = XPROCESS (proc); 3816 3817 inchannel = XINT (p->infd); 3818 outchannel = XINT (p->outfd); 3819 3820#ifdef ADAPTIVE_READ_BUFFERING 3821 if (XINT (p->read_output_delay) > 0) 3822 { 3823 if (--process_output_delay_count < 0) 3824 process_output_delay_count = 0; 3825 XSETINT (p->read_output_delay, 0); 3826 p->read_output_skip = Qnil; 3827 } 3828#endif 3829 3830 if (inchannel >= 0) 3831 { 3832 /* Beware SIGCHLD hereabouts. */ 3833 flush_pending_output (inchannel); 3834#ifdef VMS 3835 { 3836 VMS_PROC_STUFF *get_vms_process_pointer (), *vs; 3837 sys$dassgn (outchannel); 3838 vs = get_vms_process_pointer (p->pid); 3839 if (vs) 3840 give_back_vms_process_stuff (vs); 3841 } 3842#else 3843 emacs_close (inchannel); 3844 if (outchannel >= 0 && outchannel != inchannel) 3845 emacs_close (outchannel); 3846#endif 3847 3848 XSETINT (p->infd, -1); 3849 XSETINT (p->outfd, -1); 3850#ifdef DATAGRAM_SOCKETS 3851 if (DATAGRAM_CHAN_P (inchannel)) 3852 { 3853 xfree (datagram_address[inchannel].sa); 3854 datagram_address[inchannel].sa = 0; 3855 datagram_address[inchannel].len = 0; 3856 } 3857#endif 3858 chan_process[inchannel] = Qnil; 3859 FD_CLR (inchannel, &input_wait_mask); 3860 FD_CLR (inchannel, &non_keyboard_wait_mask); 3861#ifdef NON_BLOCKING_CONNECT 3862 if (FD_ISSET (inchannel, &connect_wait_mask)) 3863 { 3864 FD_CLR (inchannel, &connect_wait_mask); 3865 if (--num_pending_connects < 0) 3866 abort (); 3867 } 3868#endif 3869 if (inchannel == max_process_desc) 3870 { 3871 int i; 3872 /* We just closed the highest-numbered process input descriptor, 3873 so recompute the highest-numbered one now. */ 3874 max_process_desc = 0; 3875 for (i = 0; i < MAXDESC; i++) 3876 if (!NILP (chan_process[i])) 3877 max_process_desc = i; 3878 } 3879 } 3880} 3881 3882/* Close all descriptors currently in use for communication 3883 with subprocess. This is used in a newly-forked subprocess 3884 to get rid of irrelevant descriptors. */ 3885 3886void 3887close_process_descs () 3888{ 3889#ifndef WINDOWSNT 3890 int i; 3891 for (i = 0; i < MAXDESC; i++) 3892 { 3893 Lisp_Object process; 3894 process = chan_process[i]; 3895 if (!NILP (process)) 3896 { 3897 int in = XINT (XPROCESS (process)->infd); 3898 int out = XINT (XPROCESS (process)->outfd); 3899 if (in >= 0) 3900 emacs_close (in); 3901 if (out >= 0 && in != out) 3902 emacs_close (out); 3903 } 3904 } 3905#endif 3906} 3907 3908DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, 3909 0, 4, 0, 3910 doc: /* Allow any pending output from subprocesses to be read by Emacs. 3911It is read into the process' buffers or given to their filter functions. 3912Non-nil arg PROCESS means do not return until some output has been received 3913from PROCESS. 3914 3915Non-nil second arg SECONDS and third arg MILLISEC are number of 3916seconds and milliseconds to wait; return after that much time whether 3917or not there is input. If SECONDS is a floating point number, 3918it specifies a fractional number of seconds to wait. 3919 3920If optional fourth arg JUST-THIS-ONE is non-nil, only accept output 3921from PROCESS, suspending reading output from other processes. 3922If JUST-THIS-ONE is an integer, don't run any timers either. 3923Return non-nil iff we received any output before the timeout expired. */) 3924 (process, seconds, millisec, just_this_one) 3925 register Lisp_Object process, seconds, millisec, just_this_one; 3926{ 3927 int secs, usecs = 0; 3928 3929 if (! NILP (process)) 3930 CHECK_PROCESS (process); 3931 else 3932 just_this_one = Qnil; 3933 3934 if (!NILP (seconds)) 3935 { 3936 if (INTEGERP (seconds)) 3937 secs = XINT (seconds); 3938 else if (FLOATP (seconds)) 3939 { 3940 double timeout = XFLOAT_DATA (seconds); 3941 secs = (int) timeout; 3942 usecs = (int) ((timeout - (double) secs) * 1000000); 3943 } 3944 else 3945 wrong_type_argument (Qnumberp, seconds); 3946 3947 if (INTEGERP (millisec)) 3948 { 3949 int carry; 3950 usecs += XINT (millisec) * 1000; 3951 carry = usecs / 1000000; 3952 secs += carry; 3953 if ((usecs -= carry * 1000000) < 0) 3954 { 3955 secs--; 3956 usecs += 1000000; 3957 } 3958 } 3959 3960 if (secs < 0 || (secs == 0 && usecs == 0)) 3961 secs = -1, usecs = 0; 3962 } 3963 else 3964 secs = NILP (process) ? -1 : 0; 3965 3966 return 3967 (wait_reading_process_output (secs, usecs, 0, 0, 3968 Qnil, 3969 !NILP (process) ? XPROCESS (process) : NULL, 3970 NILP (just_this_one) ? 0 : 3971 !INTEGERP (just_this_one) ? 1 : -1) 3972 ? Qt : Qnil); 3973} 3974 3975/* Accept a connection for server process SERVER on CHANNEL. */ 3976 3977static int connect_counter = 0; 3978 3979static void 3980server_accept_connection (server, channel) 3981 Lisp_Object server; 3982 int channel; 3983{ 3984 Lisp_Object proc, caller, name, buffer; 3985 Lisp_Object contact, host, service; 3986 struct Lisp_Process *ps= XPROCESS (server); 3987 struct Lisp_Process *p; 3988 int s; 3989 union u_sockaddr { 3990 struct sockaddr sa; 3991 struct sockaddr_in in; 3992#ifdef AF_INET6 3993 struct sockaddr_in6 in6; 3994#endif 3995#ifdef HAVE_LOCAL_SOCKETS 3996 struct sockaddr_un un; 3997#endif 3998 } saddr; 3999 int len = sizeof saddr; 4000 4001 s = accept (channel, &saddr.sa, &len); 4002 4003 if (s < 0) 4004 { 4005 int code = errno; 4006 4007 if (code == EAGAIN) 4008 return; 4009#ifdef EWOULDBLOCK 4010 if (code == EWOULDBLOCK) 4011 return; 4012#endif 4013 4014 if (!NILP (ps->log)) 4015 call3 (ps->log, server, Qnil, 4016 concat3 (build_string ("accept failed with code"), 4017 Fnumber_to_string (make_number (code)), 4018 build_string ("\n"))); 4019 return; 4020 } 4021 4022 connect_counter++; 4023 4024 /* Setup a new process to handle the connection. */ 4025 4026 /* Generate a unique identification of the caller, and build contact 4027 information for this process. */ 4028 host = Qt; 4029 service = Qnil; 4030 switch (saddr.sa.sa_family) 4031 { 4032 case AF_INET: 4033 { 4034 Lisp_Object args[5]; 4035 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr; 4036 args[0] = build_string ("%d.%d.%d.%d"); 4037 args[1] = make_number (*ip++); 4038 args[2] = make_number (*ip++); 4039 args[3] = make_number (*ip++); 4040 args[4] = make_number (*ip++); 4041 host = Fformat (5, args); 4042 service = make_number (ntohs (saddr.in.sin_port)); 4043 4044 args[0] = build_string (" <%s:%d>"); 4045 args[1] = host; 4046 args[2] = service; 4047 caller = Fformat (3, args); 4048 } 4049 break; 4050 4051#ifdef AF_INET6 4052 case AF_INET6: 4053 { 4054 Lisp_Object args[9]; 4055 uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr; 4056 int i; 4057 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x"); 4058 for (i = 0; i < 8; i++) 4059 args[i+1] = make_number (ntohs(ip6[i])); 4060 host = Fformat (9, args); 4061 service = make_number (ntohs (saddr.in.sin_port)); 4062 4063 args[0] = build_string (" <[%s]:%d>"); 4064 args[1] = host; 4065 args[2] = service; 4066 caller = Fformat (3, args); 4067 } 4068 break; 4069#endif 4070 4071#ifdef HAVE_LOCAL_SOCKETS 4072 case AF_LOCAL: 4073#endif 4074 default: 4075 caller = Fnumber_to_string (make_number (connect_counter)); 4076 caller = concat3 (build_string (" <*"), caller, build_string ("*>")); 4077 break; 4078 } 4079 4080 /* Create a new buffer name for this process if it doesn't have a 4081 filter. The new buffer name is based on the buffer name or 4082 process name of the server process concatenated with the caller 4083 identification. */ 4084 4085 if (!NILP (ps->filter) && !EQ (ps->filter, Qt)) 4086 buffer = Qnil; 4087 else 4088 { 4089 buffer = ps->buffer; 4090 if (!NILP (buffer)) 4091 buffer = Fbuffer_name (buffer); 4092 else 4093 buffer = ps->name; 4094 if (!NILP (buffer)) 4095 { 4096 buffer = concat2 (buffer, caller); 4097 buffer = Fget_buffer_create (buffer); 4098 } 4099 } 4100 4101 /* Generate a unique name for the new server process. Combine the 4102 server process name with the caller identification. */ 4103 4104 name = concat2 (ps->name, caller); 4105 proc = make_process (name); 4106 4107 chan_process[s] = proc; 4108 4109#ifdef O_NONBLOCK 4110 fcntl (s, F_SETFL, O_NONBLOCK); 4111#else 4112#ifdef O_NDELAY 4113 fcntl (s, F_SETFL, O_NDELAY); 4114#endif 4115#endif 4116 4117 p = XPROCESS (proc); 4118 4119 /* Build new contact information for this setup. */ 4120 contact = Fcopy_sequence (ps->childp); 4121 contact = Fplist_put (contact, QCserver, Qnil); 4122 contact = Fplist_put (contact, QChost, host); 4123 if (!NILP (service)) 4124 contact = Fplist_put (contact, QCservice, service); 4125 contact = Fplist_put (contact, QCremote, 4126 conv_sockaddr_to_lisp (&saddr.sa, len)); 4127#ifdef HAVE_GETSOCKNAME 4128 len = sizeof saddr; 4129 if (getsockname (s, &saddr.sa, &len) == 0) 4130 contact = Fplist_put (contact, QClocal, 4131 conv_sockaddr_to_lisp (&saddr.sa, len)); 4132#endif 4133 4134 p->childp = contact; 4135 p->plist = Fcopy_sequence (ps->plist); 4136 4137 p->buffer = buffer; 4138 p->sentinel = ps->sentinel; 4139 p->filter = ps->filter; 4140 p->command = Qnil; 4141 p->pid = 0; 4142 XSETINT (p->infd, s); 4143 XSETINT (p->outfd, s); 4144 p->status = Qrun; 4145 4146 /* Client processes for accepted connections are not stopped initially. */ 4147 if (!EQ (p->filter, Qt)) 4148 { 4149 FD_SET (s, &input_wait_mask); 4150 FD_SET (s, &non_keyboard_wait_mask); 4151 } 4152 4153 if (s > max_process_desc) 4154 max_process_desc = s; 4155 4156 /* Setup coding system for new process based on server process. 4157 This seems to be the proper thing to do, as the coding system 4158 of the new process should reflect the settings at the time the 4159 server socket was opened; not the current settings. */ 4160 4161 p->decode_coding_system = ps->decode_coding_system; 4162 p->encode_coding_system = ps->encode_coding_system; 4163 setup_process_coding_systems (proc); 4164 4165 p->decoding_buf = make_uninit_string (0); 4166 p->decoding_carryover = make_number (0); 4167 p->encoding_buf = make_uninit_string (0); 4168 p->encoding_carryover = make_number (0); 4169 4170 p->inherit_coding_system_flag 4171 = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag); 4172 4173 if (!NILP (ps->log)) 4174 call3 (ps->log, server, proc, 4175 concat3 (build_string ("accept from "), 4176 (STRINGP (host) ? host : build_string ("-")), 4177 build_string ("\n"))); 4178 4179 if (!NILP (p->sentinel)) 4180 exec_sentinel (proc, 4181 concat3 (build_string ("open from "), 4182 (STRINGP (host) ? host : build_string ("-")), 4183 build_string ("\n"))); 4184} 4185 4186/* This variable is different from waiting_for_input in keyboard.c. 4187 It is used to communicate to a lisp process-filter/sentinel (via the 4188 function Fwaiting_for_user_input_p below) whether Emacs was waiting 4189 for user-input when that process-filter was called. 4190 waiting_for_input cannot be used as that is by definition 0 when 4191 lisp code is being evalled. 4192 This is also used in record_asynch_buffer_change. 4193 For that purpose, this must be 0 4194 when not inside wait_reading_process_output. */ 4195static int waiting_for_user_input_p; 4196 4197static Lisp_Object 4198wait_reading_process_output_unwind (data) 4199 Lisp_Object data; 4200{ 4201 waiting_for_user_input_p = XINT (data); 4202 return Qnil; 4203} 4204 4205/* This is here so breakpoints can be put on it. */ 4206static void 4207wait_reading_process_output_1 () 4208{ 4209} 4210 4211/* Use a wrapper around select to work around a bug in gdb 5.3. 4212 Normally, the wrapper is optimzed away by inlining. 4213 4214 If emacs is stopped inside select, the gdb backtrace doesn't 4215 show the function which called select, so it is practically 4216 impossible to step through wait_reading_process_output. */ 4217 4218#ifndef select 4219static INLINE int 4220select_wrapper (n, rfd, wfd, xfd, tmo) 4221 int n; 4222 SELECT_TYPE *rfd, *wfd, *xfd; 4223 EMACS_TIME *tmo; 4224{ 4225 return select (n, rfd, wfd, xfd, tmo); 4226} 4227#define select select_wrapper 4228#endif 4229 4230/* Read and dispose of subprocess output while waiting for timeout to 4231 elapse and/or keyboard input to be available. 4232 4233 TIME_LIMIT is: 4234 timeout in seconds, or 4235 zero for no limit, or 4236 -1 means gobble data immediately available but don't wait for any. 4237 4238 MICROSECS is: 4239 an additional duration to wait, measured in microseconds. 4240 If this is nonzero and time_limit is 0, then the timeout 4241 consists of MICROSECS only. 4242 4243 READ_KBD is a lisp value: 4244 0 to ignore keyboard input, or 4245 1 to return when input is available, or 4246 -1 meaning caller will actually read the input, so don't throw to 4247 the quit handler, or 4248 4249 DO_DISPLAY != 0 means redisplay should be done to show subprocess 4250 output that arrives. 4251 4252 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil 4253 (and gobble terminal input into the buffer if any arrives). 4254 4255 If WAIT_PROC is specified, wait until something arrives from that 4256 process. The return value is true iff we read some input from 4257 that process. 4258 4259 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC 4260 (suspending output from other processes). A negative value 4261 means don't run any timers either. 4262 4263 If WAIT_PROC is specified, then the function returns true iff we 4264 received input from that process before the timeout elapsed. 4265 Otherwise, return true iff we received input from any process. */ 4266 4267int 4268wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, 4269 wait_for_cell, wait_proc, just_wait_proc) 4270 int time_limit, microsecs, read_kbd, do_display; 4271 Lisp_Object wait_for_cell; 4272 struct Lisp_Process *wait_proc; 4273 int just_wait_proc; 4274{ 4275 register int channel, nfds; 4276 SELECT_TYPE Available; 4277#ifdef NON_BLOCKING_CONNECT 4278 SELECT_TYPE Connecting; 4279 int check_connect; 4280#endif 4281 int check_delay, no_avail; 4282 int xerrno; 4283 Lisp_Object proc; 4284 EMACS_TIME timeout, end_time; 4285 int wait_channel = -1; 4286 int got_some_input = 0; 4287 int count = SPECPDL_INDEX (); 4288 4289 FD_ZERO (&Available); 4290#ifdef NON_BLOCKING_CONNECT 4291 FD_ZERO (&Connecting); 4292#endif 4293 4294 /* If wait_proc is a process to watch, set wait_channel accordingly. */ 4295 if (wait_proc != NULL) 4296 wait_channel = XINT (wait_proc->infd); 4297 4298 record_unwind_protect (wait_reading_process_output_unwind, 4299 make_number (waiting_for_user_input_p)); 4300 waiting_for_user_input_p = read_kbd; 4301 4302 /* Since we may need to wait several times, 4303 compute the absolute time to return at. */ 4304 if (time_limit || microsecs) 4305 { 4306 EMACS_GET_TIME (end_time); 4307 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); 4308 EMACS_ADD_TIME (end_time, end_time, timeout); 4309 } 4310#ifdef POLL_INTERRUPTED_SYS_CALL 4311 /* AlainF 5-Jul-1996 4312 HP-UX 10.10 seem to have problems with signals coming in 4313 Causes "poll: interrupted system call" messages when Emacs is run 4314 in an X window 4315 Turn off periodic alarms (in case they are in use), 4316 and then turn off any other atimers. */ 4317 stop_polling (); 4318 turn_on_atimers (0); 4319#endif /* POLL_INTERRUPTED_SYS_CALL */ 4320 4321 while (1) 4322 { 4323 int timeout_reduced_for_timers = 0; 4324 4325 /* If calling from keyboard input, do not quit 4326 since we want to return C-g as an input character. 4327 Otherwise, do pending quit if requested. */ 4328 if (read_kbd >= 0) 4329 QUIT; 4330#ifdef SYNC_INPUT 4331 else if (interrupt_input_pending) 4332 handle_async_input (); 4333#endif 4334 4335 /* Exit now if the cell we're waiting for became non-nil. */ 4336 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 4337 break; 4338 4339 /* Compute time from now till when time limit is up */ 4340 /* Exit if already run out */ 4341 if (time_limit == -1) 4342 { 4343 /* -1 specified for timeout means 4344 gobble output available now 4345 but don't wait at all. */ 4346 4347 EMACS_SET_SECS_USECS (timeout, 0, 0); 4348 } 4349 else if (time_limit || microsecs) 4350 { 4351 EMACS_GET_TIME (timeout); 4352 EMACS_SUB_TIME (timeout, end_time, timeout); 4353 if (EMACS_TIME_NEG_P (timeout)) 4354 break; 4355 } 4356 else 4357 { 4358 EMACS_SET_SECS_USECS (timeout, 100000, 0); 4359 } 4360 4361 /* Normally we run timers here. 4362 But not if wait_for_cell; in those cases, 4363 the wait is supposed to be short, 4364 and those callers cannot handle running arbitrary Lisp code here. */ 4365 if (NILP (wait_for_cell) 4366 && just_wait_proc >= 0) 4367 { 4368 EMACS_TIME timer_delay; 4369 4370 do 4371 { 4372 int old_timers_run = timers_run; 4373 struct buffer *old_buffer = current_buffer; 4374 4375 timer_delay = timer_check (1); 4376 4377 /* If a timer has run, this might have changed buffers 4378 an alike. Make read_key_sequence aware of that. */ 4379 if (timers_run != old_timers_run 4380 && old_buffer != current_buffer 4381 && waiting_for_user_input_p == -1) 4382 record_asynch_buffer_change (); 4383 4384 if (timers_run != old_timers_run && do_display) 4385 /* We must retry, since a timer may have requeued itself 4386 and that could alter the time_delay. */ 4387 redisplay_preserve_echo_area (9); 4388 else 4389 break; 4390 } 4391 while (!detect_input_pending ()); 4392 4393 /* If there is unread keyboard input, also return. */ 4394 if (read_kbd != 0 4395 && requeued_events_pending_p ()) 4396 break; 4397 4398 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1) 4399 { 4400 EMACS_TIME difference; 4401 EMACS_SUB_TIME (difference, timer_delay, timeout); 4402 if (EMACS_TIME_NEG_P (difference)) 4403 { 4404 timeout = timer_delay; 4405 timeout_reduced_for_timers = 1; 4406 } 4407 } 4408 /* If time_limit is -1, we are not going to wait at all. */ 4409 else if (time_limit != -1) 4410 { 4411 /* This is so a breakpoint can be put here. */ 4412 wait_reading_process_output_1 (); 4413 } 4414 } 4415 4416 /* Cause C-g and alarm signals to take immediate action, 4417 and cause input available signals to zero out timeout. 4418 4419 It is important that we do this before checking for process 4420 activity. If we get a SIGCHLD after the explicit checks for 4421 process activity, timeout is the only way we will know. */ 4422 if (read_kbd < 0) 4423 set_waiting_for_input (&timeout); 4424 4425 /* If status of something has changed, and no input is 4426 available, notify the user of the change right away. After 4427 this explicit check, we'll let the SIGCHLD handler zap 4428 timeout to get our attention. */ 4429 if (update_tick != process_tick && do_display) 4430 { 4431 SELECT_TYPE Atemp; 4432#ifdef NON_BLOCKING_CONNECT 4433 SELECT_TYPE Ctemp; 4434#endif 4435 4436 Atemp = input_wait_mask; 4437#if 0 4438 /* On Mac OS X 10.0, the SELECT system call always says input is 4439 present (for reading) at stdin, even when none is. This 4440 causes the call to SELECT below to return 1 and 4441 status_notify not to be called. As a result output of 4442 subprocesses are incorrectly discarded. 4443 */ 4444 FD_CLR (0, &Atemp); 4445#endif 4446 IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask); 4447 4448 EMACS_SET_SECS_USECS (timeout, 0, 0); 4449 if ((select (max (max_process_desc, max_keyboard_desc) + 1, 4450 &Atemp, 4451#ifdef NON_BLOCKING_CONNECT 4452 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), 4453#else 4454 (SELECT_TYPE *)0, 4455#endif 4456 (SELECT_TYPE *)0, &timeout) 4457 <= 0)) 4458 { 4459 /* It's okay for us to do this and then continue with 4460 the loop, since timeout has already been zeroed out. */ 4461 clear_waiting_for_input (); 4462 status_notify (NULL); 4463 } 4464 } 4465 4466 /* Don't wait for output from a non-running process. Just 4467 read whatever data has already been received. */ 4468 if (wait_proc && wait_proc->raw_status_new) 4469 update_status (wait_proc); 4470 if (wait_proc 4471 && ! EQ (wait_proc->status, Qrun) 4472 && ! EQ (wait_proc->status, Qconnect)) 4473 { 4474 int nread, total_nread = 0; 4475 4476 clear_waiting_for_input (); 4477 XSETPROCESS (proc, wait_proc); 4478 4479 /* Read data from the process, until we exhaust it. */ 4480 while (XINT (wait_proc->infd) >= 0) 4481 { 4482 nread = read_process_output (proc, XINT (wait_proc->infd)); 4483 4484 if (nread == 0) 4485 break; 4486 4487 if (0 < nread) 4488 total_nread += nread; 4489#ifdef EIO 4490 else if (nread == -1 && EIO == errno) 4491 break; 4492#endif 4493#ifdef EAGAIN 4494 else if (nread == -1 && EAGAIN == errno) 4495 break; 4496#endif 4497#ifdef EWOULDBLOCK 4498 else if (nread == -1 && EWOULDBLOCK == errno) 4499 break; 4500#endif 4501 } 4502 if (total_nread > 0 && do_display) 4503 redisplay_preserve_echo_area (10); 4504 4505 break; 4506 } 4507 4508 /* Wait till there is something to do */ 4509 4510 if (wait_proc && just_wait_proc) 4511 { 4512 if (XINT (wait_proc->infd) < 0) /* Terminated */ 4513 break; 4514 FD_SET (XINT (wait_proc->infd), &Available); 4515 check_delay = 0; 4516 IF_NON_BLOCKING_CONNECT (check_connect = 0); 4517 } 4518 else if (!NILP (wait_for_cell)) 4519 { 4520 Available = non_process_wait_mask; 4521 check_delay = 0; 4522 IF_NON_BLOCKING_CONNECT (check_connect = 0); 4523 } 4524 else 4525 { 4526 if (! read_kbd) 4527 Available = non_keyboard_wait_mask; 4528 else 4529 Available = input_wait_mask; 4530 IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0)); 4531 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; 4532 } 4533 4534 /* If frame size has changed or the window is newly mapped, 4535 redisplay now, before we start to wait. There is a race 4536 condition here; if a SIGIO arrives between now and the select 4537 and indicates that a frame is trashed, the select may block 4538 displaying a trashed screen. */ 4539 if (frame_garbaged && do_display) 4540 { 4541 clear_waiting_for_input (); 4542 redisplay_preserve_echo_area (11); 4543 if (read_kbd < 0) 4544 set_waiting_for_input (&timeout); 4545 } 4546 4547 no_avail = 0; 4548 if (read_kbd && detect_input_pending ()) 4549 { 4550 nfds = 0; 4551 no_avail = 1; 4552 } 4553 else 4554 { 4555#ifdef NON_BLOCKING_CONNECT 4556 if (check_connect) 4557 Connecting = connect_wait_mask; 4558#endif 4559 4560#ifdef ADAPTIVE_READ_BUFFERING 4561 /* Set the timeout for adaptive read buffering if any 4562 process has non-nil read_output_skip and non-zero 4563 read_output_delay, and we are not reading output for a 4564 specific wait_channel. It is not executed if 4565 Vprocess_adaptive_read_buffering is nil. */ 4566 if (process_output_skip && check_delay > 0) 4567 { 4568 int usecs = EMACS_USECS (timeout); 4569 if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX) 4570 usecs = READ_OUTPUT_DELAY_MAX; 4571 for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++) 4572 { 4573 proc = chan_process[channel]; 4574 if (NILP (proc)) 4575 continue; 4576 /* Find minimum non-zero read_output_delay among the 4577 processes with non-nil read_output_skip. */ 4578 if (XINT (XPROCESS (proc)->read_output_delay) > 0) 4579 { 4580 check_delay--; 4581 if (NILP (XPROCESS (proc)->read_output_skip)) 4582 continue; 4583 FD_CLR (channel, &Available); 4584 XPROCESS (proc)->read_output_skip = Qnil; 4585 if (XINT (XPROCESS (proc)->read_output_delay) < usecs) 4586 usecs = XINT (XPROCESS (proc)->read_output_delay); 4587 } 4588 } 4589 EMACS_SET_SECS_USECS (timeout, 0, usecs); 4590 process_output_skip = 0; 4591 } 4592#endif 4593 4594 nfds = select (max (max_process_desc, max_keyboard_desc) + 1, 4595 &Available, 4596#ifdef NON_BLOCKING_CONNECT 4597 (check_connect ? &Connecting : (SELECT_TYPE *)0), 4598#else 4599 (SELECT_TYPE *)0, 4600#endif 4601 (SELECT_TYPE *)0, &timeout); 4602 } 4603 4604 xerrno = errno; 4605 4606 /* Make C-g and alarm signals set flags again */ 4607 clear_waiting_for_input (); 4608 4609 /* If we woke up due to SIGWINCH, actually change size now. */ 4610 do_pending_window_change (0); 4611 4612 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers) 4613 /* We wanted the full specified time, so return now. */ 4614 break; 4615 if (nfds < 0) 4616 { 4617 if (xerrno == EINTR) 4618 no_avail = 1; 4619#ifdef ultrix 4620 /* Ultrix select seems to return ENOMEM when it is 4621 interrupted. Treat it just like EINTR. Bleah. Note 4622 that we want to test for the "ultrix" CPP symbol, not 4623 "__ultrix__"; the latter is only defined under GCC, but 4624 not by DEC's bundled CC. -JimB */ 4625 else if (xerrno == ENOMEM) 4626 no_avail = 1; 4627#endif 4628#ifdef ALLIANT 4629 /* This happens for no known reason on ALLIANT. 4630 I am guessing that this is the right response. -- RMS. */ 4631 else if (xerrno == EFAULT) 4632 no_avail = 1; 4633#endif 4634 else if (xerrno == EBADF) 4635 { 4636#ifdef AIX 4637 /* AIX doesn't handle PTY closure the same way BSD does. On AIX, 4638 the child's closure of the pts gives the parent a SIGHUP, and 4639 the ptc file descriptor is automatically closed, 4640 yielding EBADF here or at select() call above. 4641 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF 4642 in m/ibmrt-aix.h), and here we just ignore the select error. 4643 Cleanup occurs c/o status_notify after SIGCLD. */ 4644 no_avail = 1; /* Cannot depend on values returned */ 4645#else 4646 abort (); 4647#endif 4648 } 4649 else 4650 error ("select error: %s", emacs_strerror (xerrno)); 4651 } 4652 4653 if (no_avail) 4654 { 4655 FD_ZERO (&Available); 4656 IF_NON_BLOCKING_CONNECT (check_connect = 0); 4657 } 4658 4659#if defined(sun) && !defined(USG5_4) 4660 if (nfds > 0 && keyboard_bit_set (&Available) 4661 && interrupt_input) 4662 /* System sometimes fails to deliver SIGIO. 4663 4664 David J. Mackenzie says that Emacs doesn't compile under 4665 Solaris if this code is enabled, thus the USG5_4 in the CPP 4666 conditional. "I haven't noticed any ill effects so far. 4667 If you find a Solaris expert somewhere, they might know 4668 better." */ 4669 kill (getpid (), SIGIO); 4670#endif 4671 4672#if 0 /* When polling is used, interrupt_input is 0, 4673 so get_input_pending should read the input. 4674 So this should not be needed. */ 4675 /* If we are using polling for input, 4676 and we see input available, make it get read now. 4677 Otherwise it might not actually get read for a second. 4678 And on hpux, since we turn off polling in wait_reading_process_output, 4679 it might never get read at all if we don't spend much time 4680 outside of wait_reading_process_output. */ 4681 if (read_kbd && interrupt_input 4682 && keyboard_bit_set (&Available) 4683 && input_polling_used ()) 4684 kill (getpid (), SIGALRM); 4685#endif 4686 4687 /* Check for keyboard input */ 4688 /* If there is any, return immediately 4689 to give it higher priority than subprocesses */ 4690 4691 if (read_kbd != 0) 4692 { 4693 int old_timers_run = timers_run; 4694 struct buffer *old_buffer = current_buffer; 4695 int leave = 0; 4696 4697 if (detect_input_pending_run_timers (do_display)) 4698 { 4699 swallow_events (do_display); 4700 if (detect_input_pending_run_timers (do_display)) 4701 leave = 1; 4702 } 4703 4704 /* If a timer has run, this might have changed buffers 4705 an alike. Make read_key_sequence aware of that. */ 4706 if (timers_run != old_timers_run 4707 && waiting_for_user_input_p == -1 4708 && old_buffer != current_buffer) 4709 record_asynch_buffer_change (); 4710 4711 if (leave) 4712 break; 4713 } 4714 4715 /* If there is unread keyboard input, also return. */ 4716 if (read_kbd != 0 4717 && requeued_events_pending_p ()) 4718 break; 4719 4720 /* If we are not checking for keyboard input now, 4721 do process events (but don't run any timers). 4722 This is so that X events will be processed. 4723 Otherwise they may have to wait until polling takes place. 4724 That would causes delays in pasting selections, for example. 4725 4726 (We used to do this only if wait_for_cell.) */ 4727 if (read_kbd == 0 && detect_input_pending ()) 4728 { 4729 swallow_events (do_display); 4730#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */ 4731 if (detect_input_pending ()) 4732 break; 4733#endif 4734 } 4735 4736 /* Exit now if the cell we're waiting for became non-nil. */ 4737 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 4738 break; 4739 4740#ifdef SIGIO 4741 /* If we think we have keyboard input waiting, but didn't get SIGIO, 4742 go read it. This can happen with X on BSD after logging out. 4743 In that case, there really is no input and no SIGIO, 4744 but select says there is input. */ 4745 4746 if (read_kbd && interrupt_input 4747 && keyboard_bit_set (&Available) && ! noninteractive) 4748 kill (getpid (), SIGIO); 4749#endif 4750 4751 if (! wait_proc) 4752 got_some_input |= nfds > 0; 4753 4754 /* If checking input just got us a size-change event from X, 4755 obey it now if we should. */ 4756 if (read_kbd || ! NILP (wait_for_cell)) 4757 do_pending_window_change (0); 4758 4759 /* Check for data from a process. */ 4760 if (no_avail || nfds == 0) 4761 continue; 4762 4763 /* Really FIRST_PROC_DESC should be 0 on Unix, 4764 but this is safer in the short run. */ 4765 for (channel = 0; channel <= max_process_desc; channel++) 4766 { 4767 if (FD_ISSET (channel, &Available) 4768 && FD_ISSET (channel, &non_keyboard_wait_mask)) 4769 { 4770 int nread; 4771 4772 /* If waiting for this channel, arrange to return as 4773 soon as no more input to be processed. No more 4774 waiting. */ 4775 if (wait_channel == channel) 4776 { 4777 wait_channel = -1; 4778 time_limit = -1; 4779 got_some_input = 1; 4780 } 4781 proc = chan_process[channel]; 4782 if (NILP (proc)) 4783 continue; 4784 4785 /* If this is a server stream socket, accept connection. */ 4786 if (EQ (XPROCESS (proc)->status, Qlisten)) 4787 { 4788 server_accept_connection (proc, channel); 4789 continue; 4790 } 4791 4792 /* Read data from the process, starting with our 4793 buffered-ahead character if we have one. */ 4794 4795 nread = read_process_output (proc, channel); 4796 if (nread > 0) 4797 { 4798 /* Since read_process_output can run a filter, 4799 which can call accept-process-output, 4800 don't try to read from any other processes 4801 before doing the select again. */ 4802 FD_ZERO (&Available); 4803 4804 if (do_display) 4805 redisplay_preserve_echo_area (12); 4806 } 4807#ifdef EWOULDBLOCK 4808 else if (nread == -1 && errno == EWOULDBLOCK) 4809 ; 4810#endif 4811 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK, 4812 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */ 4813#ifdef O_NONBLOCK 4814 else if (nread == -1 && errno == EAGAIN) 4815 ; 4816#else 4817#ifdef O_NDELAY 4818 else if (nread == -1 && errno == EAGAIN) 4819 ; 4820 /* Note that we cannot distinguish between no input 4821 available now and a closed pipe. 4822 With luck, a closed pipe will be accompanied by 4823 subprocess termination and SIGCHLD. */ 4824 else if (nread == 0 && !NETCONN_P (proc)) 4825 ; 4826#endif /* O_NDELAY */ 4827#endif /* O_NONBLOCK */ 4828#ifdef HAVE_PTYS 4829 /* On some OSs with ptys, when the process on one end of 4830 a pty exits, the other end gets an error reading with 4831 errno = EIO instead of getting an EOF (0 bytes read). 4832 Therefore, if we get an error reading and errno = 4833 EIO, just continue, because the child process has 4834 exited and should clean itself up soon (e.g. when we 4835 get a SIGCHLD). 4836 4837 However, it has been known to happen that the SIGCHLD 4838 got lost. So raise the signal again just in case. 4839 It can't hurt. */ 4840 else if (nread == -1 && errno == EIO) 4841 { 4842 /* Clear the descriptor now, so we only raise the signal once. */ 4843 FD_CLR (channel, &input_wait_mask); 4844 FD_CLR (channel, &non_keyboard_wait_mask); 4845 4846 kill (getpid (), SIGCHLD); 4847 } 4848#endif /* HAVE_PTYS */ 4849 /* If we can detect process termination, don't consider the process 4850 gone just because its pipe is closed. */ 4851#ifdef SIGCHLD 4852 else if (nread == 0 && !NETCONN_P (proc)) 4853 ; 4854#endif 4855 else 4856 { 4857 /* Preserve status of processes already terminated. */ 4858 XSETINT (XPROCESS (proc)->tick, ++process_tick); 4859 deactivate_process (proc); 4860 if (XPROCESS (proc)->raw_status_new) 4861 update_status (XPROCESS (proc)); 4862 if (EQ (XPROCESS (proc)->status, Qrun)) 4863 XPROCESS (proc)->status 4864 = Fcons (Qexit, Fcons (make_number (256), Qnil)); 4865 } 4866 } 4867#ifdef NON_BLOCKING_CONNECT 4868 if (check_connect && FD_ISSET (channel, &Connecting) 4869 && FD_ISSET (channel, &connect_wait_mask)) 4870 { 4871 struct Lisp_Process *p; 4872 4873 FD_CLR (channel, &connect_wait_mask); 4874 if (--num_pending_connects < 0) 4875 abort (); 4876 4877 proc = chan_process[channel]; 4878 if (NILP (proc)) 4879 continue; 4880 4881 p = XPROCESS (proc); 4882 4883#ifdef GNU_LINUX 4884 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems. 4885 So only use it on systems where it is known to work. */ 4886 { 4887 int xlen = sizeof(xerrno); 4888 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen)) 4889 xerrno = errno; 4890 } 4891#else 4892 { 4893 struct sockaddr pname; 4894 int pnamelen = sizeof(pname); 4895 4896 /* If connection failed, getpeername will fail. */ 4897 xerrno = 0; 4898 if (getpeername(channel, &pname, &pnamelen) < 0) 4899 { 4900 /* Obtain connect failure code through error slippage. */ 4901 char dummy; 4902 xerrno = errno; 4903 if (errno == ENOTCONN && read(channel, &dummy, 1) < 0) 4904 xerrno = errno; 4905 } 4906 } 4907#endif 4908 if (xerrno) 4909 { 4910 XSETINT (p->tick, ++process_tick); 4911 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); 4912 deactivate_process (proc); 4913 } 4914 else 4915 { 4916 p->status = Qrun; 4917 /* Execute the sentinel here. If we had relied on 4918 status_notify to do it later, it will read input 4919 from the process before calling the sentinel. */ 4920 exec_sentinel (proc, build_string ("open\n")); 4921 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) 4922 { 4923 FD_SET (XINT (p->infd), &input_wait_mask); 4924 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 4925 } 4926 } 4927 } 4928#endif /* NON_BLOCKING_CONNECT */ 4929 } /* end for each file descriptor */ 4930 } /* end while exit conditions not met */ 4931 4932 unbind_to (count, Qnil); 4933 4934 /* If calling from keyboard input, do not quit 4935 since we want to return C-g as an input character. 4936 Otherwise, do pending quit if requested. */ 4937 if (read_kbd >= 0) 4938 { 4939 /* Prevent input_pending from remaining set if we quit. */ 4940 clear_input_pending (); 4941 QUIT; 4942 } 4943#ifdef POLL_INTERRUPTED_SYS_CALL 4944 /* AlainF 5-Jul-1996 4945 HP-UX 10.10 seems to have problems with signals coming in 4946 Causes "poll: interrupted system call" messages when Emacs is run 4947 in an X window 4948 Turn periodic alarms back on */ 4949 start_polling (); 4950#endif /* POLL_INTERRUPTED_SYS_CALL */ 4951 4952 return got_some_input; 4953} 4954 4955/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */ 4956 4957static Lisp_Object 4958read_process_output_call (fun_and_args) 4959 Lisp_Object fun_and_args; 4960{ 4961 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args)); 4962} 4963 4964static Lisp_Object 4965read_process_output_error_handler (error) 4966 Lisp_Object error; 4967{ 4968 cmd_error_internal (error, "error in process filter: "); 4969 Vinhibit_quit = Qt; 4970 update_echo_area (); 4971 Fsleep_for (make_number (2), Qnil); 4972 return Qt; 4973} 4974 4975/* Read pending output from the process channel, 4976 starting with our buffered-ahead character if we have one. 4977 Yield number of decoded characters read. 4978 4979 This function reads at most 4096 characters. 4980 If you want to read all available subprocess output, 4981 you must call it repeatedly until it returns zero. 4982 4983 The characters read are decoded according to PROC's coding-system 4984 for decoding. */ 4985 4986static int 4987read_process_output (proc, channel) 4988 Lisp_Object proc; 4989 register int channel; 4990{ 4991 register int nbytes; 4992 char *chars; 4993 register Lisp_Object outstream; 4994 register struct buffer *old = current_buffer; 4995 register struct Lisp_Process *p = XPROCESS (proc); 4996 register int opoint; 4997 struct coding_system *coding = proc_decode_coding_system[channel]; 4998 int carryover = XINT (p->decoding_carryover); 4999 int readmax = 4096; 5000 5001#ifdef VMS 5002 VMS_PROC_STUFF *vs, *get_vms_process_pointer(); 5003 5004 vs = get_vms_process_pointer (p->pid); 5005 if (vs) 5006 { 5007 if (!vs->iosb[0]) 5008 return (0); /* Really weird if it does this */ 5009 if (!(vs->iosb[0] & 1)) 5010 return -1; /* I/O error */ 5011 } 5012 else 5013 error ("Could not get VMS process pointer"); 5014 chars = vs->inputBuffer; 5015 nbytes = clean_vms_buffer (chars, vs->iosb[1]); 5016 if (nbytes <= 0) 5017 { 5018 start_vms_process_read (vs); /* Crank up the next read on the process */ 5019 return 1; /* Nothing worth printing, say we got 1 */ 5020 } 5021 if (carryover > 0) 5022 { 5023 /* The data carried over in the previous decoding (which are at 5024 the tail of decoding buffer) should be prepended to the new 5025 data read to decode all together. */ 5026 chars = (char *) alloca (nbytes + carryover); 5027 bcopy (SDATA (p->decoding_buf), buf, carryover); 5028 bcopy (vs->inputBuffer, chars + carryover, nbytes); 5029 } 5030#else /* not VMS */ 5031 5032 chars = (char *) alloca (carryover + readmax); 5033 if (carryover) 5034 /* See the comment above. */ 5035 bcopy (SDATA (p->decoding_buf), chars, carryover); 5036 5037#ifdef DATAGRAM_SOCKETS 5038 /* We have a working select, so proc_buffered_char is always -1. */ 5039 if (DATAGRAM_CHAN_P (channel)) 5040 { 5041 int len = datagram_address[channel].len; 5042 nbytes = recvfrom (channel, chars + carryover, readmax, 5043 0, datagram_address[channel].sa, &len); 5044 } 5045 else 5046#endif 5047 if (proc_buffered_char[channel] < 0) 5048 { 5049 nbytes = emacs_read (channel, chars + carryover, readmax); 5050#ifdef ADAPTIVE_READ_BUFFERING 5051 if (nbytes > 0 && !NILP (p->adaptive_read_buffering)) 5052 { 5053 int delay = XINT (p->read_output_delay); 5054 if (nbytes < 256) 5055 { 5056 if (delay < READ_OUTPUT_DELAY_MAX_MAX) 5057 { 5058 if (delay == 0) 5059 process_output_delay_count++; 5060 delay += READ_OUTPUT_DELAY_INCREMENT * 2; 5061 } 5062 } 5063 else if (delay > 0 && (nbytes == readmax)) 5064 { 5065 delay -= READ_OUTPUT_DELAY_INCREMENT; 5066 if (delay == 0) 5067 process_output_delay_count--; 5068 } 5069 XSETINT (p->read_output_delay, delay); 5070 if (delay) 5071 { 5072 p->read_output_skip = Qt; 5073 process_output_skip = 1; 5074 } 5075 } 5076#endif 5077 } 5078 else 5079 { 5080 chars[carryover] = proc_buffered_char[channel]; 5081 proc_buffered_char[channel] = -1; 5082 nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); 5083 if (nbytes < 0) 5084 nbytes = 1; 5085 else 5086 nbytes = nbytes + 1; 5087 } 5088#endif /* not VMS */ 5089 5090 XSETINT (p->decoding_carryover, 0); 5091 5092 /* At this point, NBYTES holds number of bytes just received 5093 (including the one in proc_buffered_char[channel]). */ 5094 if (nbytes <= 0) 5095 { 5096 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK) 5097 return nbytes; 5098 coding->mode |= CODING_MODE_LAST_BLOCK; 5099 } 5100 5101 /* Now set NBYTES how many bytes we must decode. */ 5102 nbytes += carryover; 5103 5104 /* Read and dispose of the process output. */ 5105 outstream = p->filter; 5106 if (!NILP (outstream)) 5107 { 5108 /* We inhibit quit here instead of just catching it so that 5109 hitting ^G when a filter happens to be running won't screw 5110 it up. */ 5111 int count = SPECPDL_INDEX (); 5112 Lisp_Object odeactivate; 5113 Lisp_Object obuffer, okeymap; 5114 Lisp_Object text; 5115 int outer_running_asynch_code = running_asynch_code; 5116 int waiting = waiting_for_user_input_p; 5117 5118 /* No need to gcpro these, because all we do with them later 5119 is test them for EQness, and none of them should be a string. */ 5120 odeactivate = Vdeactivate_mark; 5121 XSETBUFFER (obuffer, current_buffer); 5122 okeymap = current_buffer->keymap; 5123 5124 specbind (Qinhibit_quit, Qt); 5125 specbind (Qlast_nonmenu_event, Qt); 5126 5127 /* In case we get recursively called, 5128 and we already saved the match data nonrecursively, 5129 save the same match data in safely recursive fashion. */ 5130 if (outer_running_asynch_code) 5131 { 5132 Lisp_Object tem; 5133 /* Don't clobber the CURRENT match data, either! */ 5134 tem = Fmatch_data (Qnil, Qnil, Qnil); 5135 restore_search_regs (); 5136 record_unwind_save_match_data (); 5137 Fset_match_data (tem, Qt); 5138 } 5139 5140 /* For speed, if a search happens within this code, 5141 save the match data in a special nonrecursive fashion. */ 5142 running_asynch_code = 1; 5143 5144 text = decode_coding_string (make_unibyte_string (chars, nbytes), 5145 coding, 0); 5146 Vlast_coding_system_used = coding->symbol; 5147 /* A new coding system might be found. */ 5148 if (!EQ (p->decode_coding_system, coding->symbol)) 5149 { 5150 p->decode_coding_system = coding->symbol; 5151 5152 /* Don't call setup_coding_system for 5153 proc_decode_coding_system[channel] here. It is done in 5154 detect_coding called via decode_coding above. */ 5155 5156 /* If a coding system for encoding is not yet decided, we set 5157 it as the same as coding-system for decoding. 5158 5159 But, before doing that we must check if 5160 proc_encode_coding_system[p->outfd] surely points to a 5161 valid memory because p->outfd will be changed once EOF is 5162 sent to the process. */ 5163 if (NILP (p->encode_coding_system) 5164 && proc_encode_coding_system[XINT (p->outfd)]) 5165 { 5166 p->encode_coding_system = coding->symbol; 5167 setup_coding_system (coding->symbol, 5168 proc_encode_coding_system[XINT (p->outfd)]); 5169 if (proc_encode_coding_system[XINT (p->outfd)]->eol_type 5170 == CODING_EOL_UNDECIDED) 5171 proc_encode_coding_system[XINT (p->outfd)]->eol_type 5172 = system_eol_type; 5173 } 5174 } 5175 5176 carryover = nbytes - coding->consumed; 5177 if (carryover < 0) 5178 abort (); 5179 5180 if (SCHARS (p->decoding_buf) < carryover) 5181 p->decoding_buf = make_uninit_string (carryover); 5182 bcopy (chars + coding->consumed, SDATA (p->decoding_buf), 5183 carryover); 5184 XSETINT (p->decoding_carryover, carryover); 5185 /* Adjust the multibyteness of TEXT to that of the filter. */ 5186 if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text)) 5187 text = (STRING_MULTIBYTE (text) 5188 ? Fstring_as_unibyte (text) 5189 : Fstring_to_multibyte (text)); 5190 if (SBYTES (text) > 0) 5191 internal_condition_case_1 (read_process_output_call, 5192 Fcons (outstream, 5193 Fcons (proc, Fcons (text, Qnil))), 5194 !NILP (Vdebug_on_error) ? Qnil : Qerror, 5195 read_process_output_error_handler); 5196 5197 /* If we saved the match data nonrecursively, restore it now. */ 5198 restore_search_regs (); 5199 running_asynch_code = outer_running_asynch_code; 5200 5201 /* Handling the process output should not deactivate the mark. */ 5202 Vdeactivate_mark = odeactivate; 5203 5204 /* Restore waiting_for_user_input_p as it was 5205 when we were called, in case the filter clobbered it. */ 5206 waiting_for_user_input_p = waiting; 5207 5208#if 0 /* Call record_asynch_buffer_change unconditionally, 5209 because we might have changed minor modes or other things 5210 that affect key bindings. */ 5211 if (! EQ (Fcurrent_buffer (), obuffer) 5212 || ! EQ (current_buffer->keymap, okeymap)) 5213#endif 5214 /* But do it only if the caller is actually going to read events. 5215 Otherwise there's no need to make him wake up, and it could 5216 cause trouble (for example it would make sit_for return). */ 5217 if (waiting_for_user_input_p == -1) 5218 record_asynch_buffer_change (); 5219 5220#ifdef VMS 5221 start_vms_process_read (vs); 5222#endif 5223 unbind_to (count, Qnil); 5224 return nbytes; 5225 } 5226 5227 /* If no filter, write into buffer if it isn't dead. */ 5228 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) 5229 { 5230 Lisp_Object old_read_only; 5231 int old_begv, old_zv; 5232 int old_begv_byte, old_zv_byte; 5233 Lisp_Object odeactivate; 5234 int before, before_byte; 5235 int opoint_byte; 5236 Lisp_Object text; 5237 struct buffer *b; 5238 5239 odeactivate = Vdeactivate_mark; 5240 5241 Fset_buffer (p->buffer); 5242 opoint = PT; 5243 opoint_byte = PT_BYTE; 5244 old_read_only = current_buffer->read_only; 5245 old_begv = BEGV; 5246 old_zv = ZV; 5247 old_begv_byte = BEGV_BYTE; 5248 old_zv_byte = ZV_BYTE; 5249 5250 current_buffer->read_only = Qnil; 5251 5252 /* Insert new output into buffer 5253 at the current end-of-output marker, 5254 thus preserving logical ordering of input and output. */ 5255 if (XMARKER (p->mark)->buffer) 5256 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV), 5257 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark), 5258 ZV_BYTE)); 5259 else 5260 SET_PT_BOTH (ZV, ZV_BYTE); 5261 before = PT; 5262 before_byte = PT_BYTE; 5263 5264 /* If the output marker is outside of the visible region, save 5265 the restriction and widen. */ 5266 if (! (BEGV <= PT && PT <= ZV)) 5267 Fwiden (); 5268 5269 text = decode_coding_string (make_unibyte_string (chars, nbytes), 5270 coding, 0); 5271 Vlast_coding_system_used = coding->symbol; 5272 /* A new coding system might be found. See the comment in the 5273 similar code in the previous `if' block. */ 5274 if (!EQ (p->decode_coding_system, coding->symbol)) 5275 { 5276 p->decode_coding_system = coding->symbol; 5277 if (NILP (p->encode_coding_system) 5278 && proc_encode_coding_system[XINT (p->outfd)]) 5279 { 5280 p->encode_coding_system = coding->symbol; 5281 setup_coding_system (coding->symbol, 5282 proc_encode_coding_system[XINT (p->outfd)]); 5283 if (proc_encode_coding_system[XINT (p->outfd)]->eol_type 5284 == CODING_EOL_UNDECIDED) 5285 proc_encode_coding_system[XINT (p->outfd)]->eol_type 5286 = system_eol_type; 5287 } 5288 } 5289 carryover = nbytes - coding->consumed; 5290 if (carryover < 0) 5291 abort (); 5292 5293 if (SCHARS (p->decoding_buf) < carryover) 5294 p->decoding_buf = make_uninit_string (carryover); 5295 bcopy (chars + coding->consumed, SDATA (p->decoding_buf), 5296 carryover); 5297 XSETINT (p->decoding_carryover, carryover); 5298 5299 /* Adjust the multibyteness of TEXT to that of the buffer. */ 5300 if (NILP (current_buffer->enable_multibyte_characters) 5301 != ! STRING_MULTIBYTE (text)) 5302 text = (STRING_MULTIBYTE (text) 5303 ? Fstring_as_unibyte (text) 5304 : Fstring_to_multibyte (text)); 5305 /* Insert before markers in case we are inserting where 5306 the buffer's mark is, and the user's next command is Meta-y. */ 5307 insert_from_string_before_markers (text, 0, 0, 5308 SCHARS (text), SBYTES (text), 0); 5309 5310 /* Make sure the process marker's position is valid when the 5311 process buffer is changed in the signal_after_change above. 5312 W3 is known to do that. */ 5313 if (BUFFERP (p->buffer) 5314 && (b = XBUFFER (p->buffer), b != current_buffer)) 5315 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b)); 5316 else 5317 set_marker_both (p->mark, p->buffer, PT, PT_BYTE); 5318 5319 update_mode_lines++; 5320 5321 /* Make sure opoint and the old restrictions 5322 float ahead of any new text just as point would. */ 5323 if (opoint >= before) 5324 { 5325 opoint += PT - before; 5326 opoint_byte += PT_BYTE - before_byte; 5327 } 5328 if (old_begv > before) 5329 { 5330 old_begv += PT - before; 5331 old_begv_byte += PT_BYTE - before_byte; 5332 } 5333 if (old_zv >= before) 5334 { 5335 old_zv += PT - before; 5336 old_zv_byte += PT_BYTE - before_byte; 5337 } 5338 5339 /* If the restriction isn't what it should be, set it. */ 5340 if (old_begv != BEGV || old_zv != ZV) 5341 Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); 5342 5343 /* Handling the process output should not deactivate the mark. */ 5344 Vdeactivate_mark = odeactivate; 5345 5346 current_buffer->read_only = old_read_only; 5347 SET_PT_BOTH (opoint, opoint_byte); 5348 set_buffer_internal (old); 5349 } 5350#ifdef VMS 5351 start_vms_process_read (vs); 5352#endif 5353 return nbytes; 5354} 5355 5356DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 5357 0, 0, 0, 5358 doc: /* Returns non-nil if Emacs is waiting for input from the user. 5359This is intended for use by asynchronous process output filters and sentinels. */) 5360 () 5361{ 5362 return (waiting_for_user_input_p ? Qt : Qnil); 5363} 5364 5365/* Sending data to subprocess */ 5366 5367jmp_buf send_process_frame; 5368Lisp_Object process_sent_to; 5369 5370SIGTYPE 5371send_process_trap () 5372{ 5373 SIGNAL_THREAD_CHECK (SIGPIPE); 5374#ifdef BSD4_1 5375 sigrelse (SIGPIPE); 5376 sigrelse (SIGALRM); 5377#endif /* BSD4_1 */ 5378 sigunblock (sigmask (SIGPIPE)); 5379 longjmp (send_process_frame, 1); 5380} 5381 5382/* Send some data to process PROC. 5383 BUF is the beginning of the data; LEN is the number of characters. 5384 OBJECT is the Lisp object that the data comes from. If OBJECT is 5385 nil or t, it means that the data comes from C string. 5386 5387 If OBJECT is not nil, the data is encoded by PROC's coding-system 5388 for encoding before it is sent. 5389 5390 This function can evaluate Lisp code and can garbage collect. */ 5391 5392static void 5393send_process (proc, buf, len, object) 5394 volatile Lisp_Object proc; 5395 unsigned char *volatile buf; 5396 volatile int len; 5397 volatile Lisp_Object object; 5398{ 5399 /* Use volatile to protect variables from being clobbered by longjmp. */ 5400 struct Lisp_Process *p = XPROCESS (proc); 5401 int rv; 5402 struct coding_system *coding; 5403 struct gcpro gcpro1; 5404 SIGTYPE (*volatile old_sigpipe) (); 5405 5406 GCPRO1 (object); 5407 5408#ifdef VMS 5409 VMS_PROC_STUFF *vs, *get_vms_process_pointer(); 5410#endif /* VMS */ 5411 5412 if (p->raw_status_new) 5413 update_status (p); 5414 if (! EQ (p->status, Qrun)) 5415 error ("Process %s not running", SDATA (p->name)); 5416 if (XINT (p->outfd) < 0) 5417 error ("Output file descriptor of %s is closed", SDATA (p->name)); 5418 5419 coding = proc_encode_coding_system[XINT (p->outfd)]; 5420 Vlast_coding_system_used = coding->symbol; 5421 5422 if ((STRINGP (object) && STRING_MULTIBYTE (object)) 5423 || (BUFFERP (object) 5424 && !NILP (XBUFFER (object)->enable_multibyte_characters)) 5425 || EQ (object, Qt)) 5426 { 5427 if (!EQ (coding->symbol, p->encode_coding_system)) 5428 /* The coding system for encoding was changed to raw-text 5429 because we sent a unibyte text previously. Now we are 5430 sending a multibyte text, thus we must encode it by the 5431 original coding system specified for the current process. */ 5432 setup_coding_system (p->encode_coding_system, coding); 5433 if (coding->eol_type == CODING_EOL_UNDECIDED) 5434 coding->eol_type = system_eol_type; 5435 /* src_multibyte should be set to 1 _after_ a call to 5436 setup_coding_system, since it resets src_multibyte to 5437 zero. */ 5438 coding->src_multibyte = 1; 5439 } 5440 else 5441 { 5442 /* For sending a unibyte text, character code conversion should 5443 not take place but EOL conversion should. So, setup raw-text 5444 or one of the subsidiary if we have not yet done it. */ 5445 if (coding->type != coding_type_raw_text) 5446 { 5447 if (CODING_REQUIRE_FLUSHING (coding)) 5448 { 5449 /* But, before changing the coding, we must flush out data. */ 5450 coding->mode |= CODING_MODE_LAST_BLOCK; 5451 send_process (proc, "", 0, Qt); 5452 } 5453 coding->src_multibyte = 0; 5454 setup_raw_text_coding_system (coding); 5455 } 5456 } 5457 coding->dst_multibyte = 0; 5458 5459 if (CODING_REQUIRE_ENCODING (coding)) 5460 { 5461 int require = encoding_buffer_size (coding, len); 5462 int from_byte = -1, from = -1, to = -1; 5463 5464 if (BUFFERP (object)) 5465 { 5466 from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf); 5467 from = buf_bytepos_to_charpos (XBUFFER (object), from_byte); 5468 to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len); 5469 } 5470 else if (STRINGP (object)) 5471 { 5472 from_byte = buf - SDATA (object); 5473 from = string_byte_to_char (object, from_byte); 5474 to = string_byte_to_char (object, from_byte + len); 5475 } 5476 5477 if (coding->composing != COMPOSITION_DISABLED) 5478 { 5479 if (from_byte >= 0) 5480 coding_save_composition (coding, from, to, object); 5481 else 5482 coding->composing = COMPOSITION_DISABLED; 5483 } 5484 5485 if (SBYTES (p->encoding_buf) < require) 5486 p->encoding_buf = make_uninit_string (require); 5487 5488 if (from_byte >= 0) 5489 buf = (BUFFERP (object) 5490 ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte) 5491 : SDATA (object) + from_byte); 5492 5493 object = p->encoding_buf; 5494 encode_coding (coding, (char *) buf, SDATA (object), 5495 len, SBYTES (object)); 5496 coding_free_composition_data (coding); 5497 len = coding->produced; 5498 buf = SDATA (object); 5499 } 5500 5501#ifdef VMS 5502 vs = get_vms_process_pointer (p->pid); 5503 if (vs == 0) 5504 error ("Could not find this process: %x", p->pid); 5505 else if (write_to_vms_process (vs, buf, len)) 5506 ; 5507#else /* not VMS */ 5508 5509 if (pty_max_bytes == 0) 5510 { 5511#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) 5512 pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON); 5513 if (pty_max_bytes < 0) 5514 pty_max_bytes = 250; 5515#else 5516 pty_max_bytes = 250; 5517#endif 5518 /* Deduct one, to leave space for the eof. */ 5519 pty_max_bytes--; 5520 } 5521 5522 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2, 5523 CFLAGS="-g -O": The value of the parameter `proc' is clobbered 5524 when returning with longjmp despite being declared volatile. */ 5525 if (!setjmp (send_process_frame)) 5526 { 5527 process_sent_to = proc; 5528 while (len > 0) 5529 { 5530 int this = len; 5531 5532 /* Decide how much data we can send in one batch. 5533 Long lines need to be split into multiple batches. */ 5534 if (!NILP (p->pty_flag)) 5535 { 5536 /* Starting this at zero is always correct when not the first 5537 iteration because the previous iteration ended by sending C-d. 5538 It may not be correct for the first iteration 5539 if a partial line was sent in a separate send_process call. 5540 If that proves worth handling, we need to save linepos 5541 in the process object. */ 5542 int linepos = 0; 5543 unsigned char *ptr = (unsigned char *) buf; 5544 unsigned char *end = (unsigned char *) buf + len; 5545 5546 /* Scan through this text for a line that is too long. */ 5547 while (ptr != end && linepos < pty_max_bytes) 5548 { 5549 if (*ptr == '\n') 5550 linepos = 0; 5551 else 5552 linepos++; 5553 ptr++; 5554 } 5555 /* If we found one, break the line there 5556 and put in a C-d to force the buffer through. */ 5557 this = ptr - buf; 5558 } 5559 5560 /* Send this batch, using one or more write calls. */ 5561 while (this > 0) 5562 { 5563 int outfd = XINT (p->outfd); 5564 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); 5565#ifdef DATAGRAM_SOCKETS 5566 if (DATAGRAM_CHAN_P (outfd)) 5567 { 5568 rv = sendto (outfd, (char *) buf, this, 5569 0, datagram_address[outfd].sa, 5570 datagram_address[outfd].len); 5571 if (rv < 0 && errno == EMSGSIZE) 5572 { 5573 signal (SIGPIPE, old_sigpipe); 5574 report_file_error ("sending datagram", 5575 Fcons (proc, Qnil)); 5576 } 5577 } 5578 else 5579#endif 5580 { 5581 rv = emacs_write (outfd, (char *) buf, this); 5582#ifdef ADAPTIVE_READ_BUFFERING 5583 if (XINT (p->read_output_delay) > 0 5584 && EQ (p->adaptive_read_buffering, Qt)) 5585 { 5586 XSETFASTINT (p->read_output_delay, 0); 5587 process_output_delay_count--; 5588 p->read_output_skip = Qnil; 5589 } 5590#endif 5591 } 5592 signal (SIGPIPE, old_sigpipe); 5593 5594 if (rv < 0) 5595 { 5596 if (0 5597#ifdef EWOULDBLOCK 5598 || errno == EWOULDBLOCK 5599#endif 5600#ifdef EAGAIN 5601 || errno == EAGAIN 5602#endif 5603 ) 5604 /* Buffer is full. Wait, accepting input; 5605 that may allow the program 5606 to finish doing output and read more. */ 5607 { 5608 int offset = 0; 5609 5610#ifdef BROKEN_PTY_READ_AFTER_EAGAIN 5611 /* A gross hack to work around a bug in FreeBSD. 5612 In the following sequence, read(2) returns 5613 bogus data: 5614 5615 write(2) 1022 bytes 5616 write(2) 954 bytes, get EAGAIN 5617 read(2) 1024 bytes in process_read_output 5618 read(2) 11 bytes in process_read_output 5619 5620 That is, read(2) returns more bytes than have 5621 ever been written successfully. The 1033 bytes 5622 read are the 1022 bytes written successfully 5623 after processing (for example with CRs added if 5624 the terminal is set up that way which it is 5625 here). The same bytes will be seen again in a 5626 later read(2), without the CRs. */ 5627 5628 if (errno == EAGAIN) 5629 { 5630 int flags = FWRITE; 5631 ioctl (XINT (p->outfd), TIOCFLUSH, &flags); 5632 } 5633#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ 5634 5635 /* Running filters might relocate buffers or strings. 5636 Arrange to relocate BUF. */ 5637 if (BUFFERP (object)) 5638 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf); 5639 else if (STRINGP (object)) 5640 offset = buf - SDATA (object); 5641 5642#ifdef EMACS_HAS_USECS 5643 wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0); 5644#else 5645 wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0); 5646#endif 5647 5648 if (BUFFERP (object)) 5649 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset); 5650 else if (STRINGP (object)) 5651 buf = offset + SDATA (object); 5652 5653 rv = 0; 5654 } 5655 else 5656 /* This is a real error. */ 5657 report_file_error ("writing to process", Fcons (proc, Qnil)); 5658 } 5659 buf += rv; 5660 len -= rv; 5661 this -= rv; 5662 } 5663 5664 /* If we sent just part of the string, put in an EOF 5665 to force it through, before we send the rest. */ 5666 if (len > 0) 5667 Fprocess_send_eof (proc); 5668 } 5669 } 5670#endif /* not VMS */ 5671 else 5672 { 5673 signal (SIGPIPE, old_sigpipe); 5674#ifndef VMS 5675 proc = process_sent_to; 5676 p = XPROCESS (proc); 5677#endif 5678 p->raw_status_new = 0; 5679 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); 5680 XSETINT (p->tick, ++process_tick); 5681 deactivate_process (proc); 5682#ifdef VMS 5683 error ("Error writing to process %s; closed it", SDATA (p->name)); 5684#else 5685 error ("SIGPIPE raised on process %s; closed it", SDATA (p->name)); 5686#endif 5687 } 5688 5689 UNGCPRO; 5690} 5691 5692static Lisp_Object 5693send_process_object_unwind (buf) 5694 Lisp_Object buf; 5695{ 5696 Lisp_Object tembuf; 5697 5698 if (XBUFFER (buf) == current_buffer) 5699 return Qnil; 5700 tembuf = Fcurrent_buffer (); 5701 Fset_buffer (buf); 5702 Fkill_buffer (tembuf); 5703 return Qnil; 5704} 5705 5706/* Send current contents of region between START and END to PROC. 5707 If START is a string, send it instead. 5708 This function can evaluate Lisp code and can garbage collect. */ 5709 5710static void 5711send_process_object (proc, start, end) 5712 Lisp_Object proc, start, end; 5713{ 5714 int count = SPECPDL_INDEX (); 5715 Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer (); 5716 struct buffer *given_buffer = current_buffer; 5717 unsigned char *buf; 5718 int len; 5719 5720 record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ()); 5721 5722 if (STRINGP (object) ? STRING_MULTIBYTE (object) 5723 : ! NILP (XBUFFER (object)->enable_multibyte_characters)) 5724 { 5725 struct Lisp_Process *p = XPROCESS (proc); 5726 struct coding_system *coding; 5727 5728 if (p->raw_status_new) 5729 update_status (p); 5730 if (! EQ (p->status, Qrun)) 5731 error ("Process %s not running", SDATA (p->name)); 5732 if (XINT (p->outfd) < 0) 5733 error ("Output file descriptor of %s is closed", SDATA (p->name)); 5734 5735 coding = proc_encode_coding_system[XINT (p->outfd)]; 5736 if (! EQ (coding->symbol, p->encode_coding_system)) 5737 /* The coding system for encoding was changed to raw-text 5738 because we sent a unibyte text previously. Now we are 5739 sending a multibyte text, thus we must encode it by the 5740 original coding system specified for the current process. */ 5741 setup_coding_system (p->encode_coding_system, coding); 5742 if (! NILP (coding->pre_write_conversion)) 5743 { 5744 struct gcpro gcpro1, gcpro2; 5745 5746 GCPRO2 (proc, object); 5747 call2 (coding->pre_write_conversion, start, end); 5748 UNGCPRO; 5749 if (given_buffer != current_buffer) 5750 { 5751 start = make_number (BEGV), end = make_number (ZV); 5752 object = Fcurrent_buffer (); 5753 } 5754 } 5755 } 5756 5757 if (BUFFERP (object)) 5758 { 5759 EMACS_INT start_byte; 5760 5761 if (XINT (start) < GPT && XINT (end) > GPT) 5762 move_gap (XINT (end)); 5763 start_byte = CHAR_TO_BYTE (XINT (start)); 5764 buf = BYTE_POS_ADDR (start_byte); 5765 len = CHAR_TO_BYTE (XINT (end)) - start_byte; 5766 } 5767 else 5768 { 5769 buf = SDATA (object); 5770 len = SBYTES (object); 5771 } 5772 send_process (proc, buf, len, object); 5773 5774 unbind_to (count, Qnil); 5775} 5776 5777DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, 5778 3, 3, 0, 5779 doc: /* Send current contents of region as input to PROCESS. 5780PROCESS may be a process, a buffer, the name of a process or buffer, or 5781nil, indicating the current buffer's process. 5782Called from program, takes three arguments, PROCESS, START and END. 5783If the region is more than 500 characters long, 5784it is sent in several bunches. This may happen even for shorter regions. 5785Output from processes can arrive in between bunches. */) 5786 (process, start, end) 5787 Lisp_Object process, start, end; 5788{ 5789 Lisp_Object proc; 5790 5791 proc = get_process (process); 5792 validate_region (&start, &end); 5793 send_process_object (proc, start, end); 5794 return Qnil; 5795} 5796 5797DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, 5798 2, 2, 0, 5799 doc: /* Send PROCESS the contents of STRING as input. 5800PROCESS may be a process, a buffer, the name of a process or buffer, or 5801nil, indicating the current buffer's process. 5802If STRING is more than 500 characters long, 5803it is sent in several bunches. This may happen even for shorter strings. 5804Output from processes can arrive in between bunches. */) 5805 (process, string) 5806 Lisp_Object process, string; 5807{ 5808 Lisp_Object proc; 5809 CHECK_STRING (string); 5810 proc = get_process (process); 5811 send_process_object (proc, string, Qnil); 5812 return Qnil; 5813} 5814 5815/* Return the foreground process group for the tty/pty that 5816 the process P uses. */ 5817static int 5818emacs_get_tty_pgrp (p) 5819 struct Lisp_Process *p; 5820{ 5821 int gid = -1; 5822 5823#ifdef TIOCGPGRP 5824 if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) 5825 { 5826 int fd; 5827 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the 5828 master side. Try the slave side. */ 5829 fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0); 5830 5831 if (fd != -1) 5832 { 5833 ioctl (fd, TIOCGPGRP, &gid); 5834 emacs_close (fd); 5835 } 5836 } 5837#endif /* defined (TIOCGPGRP ) */ 5838 5839 return gid; 5840} 5841 5842DEFUN ("process-running-child-p", Fprocess_running_child_p, 5843 Sprocess_running_child_p, 0, 1, 0, 5844 doc: /* Return t if PROCESS has given the terminal to a child. 5845If the operating system does not make it possible to find out, 5846return t unconditionally. */) 5847 (process) 5848 Lisp_Object process; 5849{ 5850 /* Initialize in case ioctl doesn't exist or gives an error, 5851 in a way that will cause returning t. */ 5852 int gid; 5853 Lisp_Object proc; 5854 struct Lisp_Process *p; 5855 5856 proc = get_process (process); 5857 p = XPROCESS (proc); 5858 5859 if (!EQ (p->childp, Qt)) 5860 error ("Process %s is not a subprocess", 5861 SDATA (p->name)); 5862 if (XINT (p->infd) < 0) 5863 error ("Process %s is not active", 5864 SDATA (p->name)); 5865 5866 gid = emacs_get_tty_pgrp (p); 5867 5868 if (gid == p->pid) 5869 return Qnil; 5870 return Qt; 5871} 5872 5873/* send a signal number SIGNO to PROCESS. 5874 If CURRENT_GROUP is t, that means send to the process group 5875 that currently owns the terminal being used to communicate with PROCESS. 5876 This is used for various commands in shell mode. 5877 If CURRENT_GROUP is lambda, that means send to the process group 5878 that currently owns the terminal, but only if it is NOT the shell itself. 5879 5880 If NOMSG is zero, insert signal-announcements into process's buffers 5881 right away. 5882 5883 If we can, we try to signal PROCESS by sending control characters 5884 down the pty. This allows us to signal inferiors who have changed 5885 their uid, for which killpg would return an EPERM error. */ 5886 5887static void 5888process_send_signal (process, signo, current_group, nomsg) 5889 Lisp_Object process; 5890 int signo; 5891 Lisp_Object current_group; 5892 int nomsg; 5893{ 5894 Lisp_Object proc; 5895 register struct Lisp_Process *p; 5896 int gid; 5897 int no_pgrp = 0; 5898 5899 proc = get_process (process); 5900 p = XPROCESS (proc); 5901 5902 if (!EQ (p->childp, Qt)) 5903 error ("Process %s is not a subprocess", 5904 SDATA (p->name)); 5905 if (XINT (p->infd) < 0) 5906 error ("Process %s is not active", 5907 SDATA (p->name)); 5908 5909 if (NILP (p->pty_flag)) 5910 current_group = Qnil; 5911 5912 /* If we are using pgrps, get a pgrp number and make it negative. */ 5913 if (NILP (current_group)) 5914 /* Send the signal to the shell's process group. */ 5915 gid = p->pid; 5916 else 5917 { 5918#ifdef SIGNALS_VIA_CHARACTERS 5919 /* If possible, send signals to the entire pgrp 5920 by sending an input character to it. */ 5921 5922 /* TERMIOS is the latest and bestest, and seems most likely to 5923 work. If the system has it, use it. */ 5924#ifdef HAVE_TERMIOS 5925 struct termios t; 5926 cc_t *sig_char = NULL; 5927 5928 tcgetattr (XINT (p->infd), &t); 5929 5930 switch (signo) 5931 { 5932 case SIGINT: 5933 sig_char = &t.c_cc[VINTR]; 5934 break; 5935 5936 case SIGQUIT: 5937 sig_char = &t.c_cc[VQUIT]; 5938 break; 5939 5940 case SIGTSTP: 5941#if defined (VSWTCH) && !defined (PREFER_VSUSP) 5942 sig_char = &t.c_cc[VSWTCH]; 5943#else 5944 sig_char = &t.c_cc[VSUSP]; 5945#endif 5946 break; 5947 } 5948 5949 if (sig_char && *sig_char != CDISABLE) 5950 { 5951 send_process (proc, sig_char, 1, Qnil); 5952 return; 5953 } 5954 /* If we can't send the signal with a character, 5955 fall through and send it another way. */ 5956#else /* ! HAVE_TERMIOS */ 5957 5958 /* On Berkeley descendants, the following IOCTL's retrieve the 5959 current control characters. */ 5960#if defined (TIOCGLTC) && defined (TIOCGETC) 5961 5962 struct tchars c; 5963 struct ltchars lc; 5964 5965 switch (signo) 5966 { 5967 case SIGINT: 5968 ioctl (XINT (p->infd), TIOCGETC, &c); 5969 send_process (proc, &c.t_intrc, 1, Qnil); 5970 return; 5971 case SIGQUIT: 5972 ioctl (XINT (p->infd), TIOCGETC, &c); 5973 send_process (proc, &c.t_quitc, 1, Qnil); 5974 return; 5975#ifdef SIGTSTP 5976 case SIGTSTP: 5977 ioctl (XINT (p->infd), TIOCGLTC, &lc); 5978 send_process (proc, &lc.t_suspc, 1, Qnil); 5979 return; 5980#endif /* ! defined (SIGTSTP) */ 5981 } 5982 5983#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ 5984 5985 /* On SYSV descendants, the TCGETA ioctl retrieves the current control 5986 characters. */ 5987#ifdef TCGETA 5988 struct termio t; 5989 switch (signo) 5990 { 5991 case SIGINT: 5992 ioctl (XINT (p->infd), TCGETA, &t); 5993 send_process (proc, &t.c_cc[VINTR], 1, Qnil); 5994 return; 5995 case SIGQUIT: 5996 ioctl (XINT (p->infd), TCGETA, &t); 5997 send_process (proc, &t.c_cc[VQUIT], 1, Qnil); 5998 return; 5999#ifdef SIGTSTP 6000 case SIGTSTP: 6001 ioctl (XINT (p->infd), TCGETA, &t); 6002 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); 6003 return; 6004#endif /* ! defined (SIGTSTP) */ 6005 } 6006#else /* ! defined (TCGETA) */ 6007 Your configuration files are messed up. 6008 /* If your system configuration files define SIGNALS_VIA_CHARACTERS, 6009 you'd better be using one of the alternatives above! */ 6010#endif /* ! defined (TCGETA) */ 6011#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ 6012 /* In this case, the code above should alway returns. */ 6013 abort (); 6014#endif /* ! defined HAVE_TERMIOS */ 6015 6016 /* The code above may fall through if it can't 6017 handle the signal. */ 6018#endif /* defined (SIGNALS_VIA_CHARACTERS) */ 6019 6020#ifdef TIOCGPGRP 6021 /* Get the current pgrp using the tty itself, if we have that. 6022 Otherwise, use the pty to get the pgrp. 6023 On pfa systems, saka@pfu.fujitsu.co.JP writes: 6024 "TIOCGPGRP symbol defined in sys/ioctl.h at E50. 6025 But, TIOCGPGRP does not work on E50 ;-P works fine on E60" 6026 His patch indicates that if TIOCGPGRP returns an error, then 6027 we should just assume that p->pid is also the process group id. */ 6028 6029 gid = emacs_get_tty_pgrp (p); 6030 6031 if (gid == -1) 6032 /* If we can't get the information, assume 6033 the shell owns the tty. */ 6034 gid = p->pid; 6035 6036 /* It is not clear whether anything really can set GID to -1. 6037 Perhaps on some system one of those ioctls can or could do so. 6038 Or perhaps this is vestigial. */ 6039 if (gid == -1) 6040 no_pgrp = 1; 6041#else /* ! defined (TIOCGPGRP ) */ 6042 /* Can't select pgrps on this system, so we know that 6043 the child itself heads the pgrp. */ 6044 gid = p->pid; 6045#endif /* ! defined (TIOCGPGRP ) */ 6046 6047 /* If current_group is lambda, and the shell owns the terminal, 6048 don't send any signal. */ 6049 if (EQ (current_group, Qlambda) && gid == p->pid) 6050 return; 6051 } 6052 6053 switch (signo) 6054 { 6055#ifdef SIGCONT 6056 case SIGCONT: 6057 p->raw_status_new = 0; 6058 p->status = Qrun; 6059 XSETINT (p->tick, ++process_tick); 6060 if (!nomsg) 6061 status_notify (NULL); 6062 break; 6063#endif /* ! defined (SIGCONT) */ 6064 case SIGINT: 6065#ifdef VMS 6066 send_process (proc, "\003", 1, Qnil); /* ^C */ 6067 goto whoosh; 6068#endif 6069 case SIGQUIT: 6070#ifdef VMS 6071 send_process (proc, "\031", 1, Qnil); /* ^Y */ 6072 goto whoosh; 6073#endif 6074 case SIGKILL: 6075#ifdef VMS 6076 sys$forcex (&(p->pid), 0, 1); 6077 whoosh: 6078#endif 6079 flush_pending_output (XINT (p->infd)); 6080 break; 6081 } 6082 6083 /* If we don't have process groups, send the signal to the immediate 6084 subprocess. That isn't really right, but it's better than any 6085 obvious alternative. */ 6086 if (no_pgrp) 6087 { 6088 kill (p->pid, signo); 6089 return; 6090 } 6091 6092 /* gid may be a pid, or minus a pgrp's number */ 6093#ifdef TIOCSIGSEND 6094 if (!NILP (current_group)) 6095 { 6096 if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1) 6097 EMACS_KILLPG (gid, signo); 6098 } 6099 else 6100 { 6101 gid = - p->pid; 6102 kill (gid, signo); 6103 } 6104#else /* ! defined (TIOCSIGSEND) */ 6105 EMACS_KILLPG (gid, signo); 6106#endif /* ! defined (TIOCSIGSEND) */ 6107} 6108 6109DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, 6110 doc: /* Interrupt process PROCESS. 6111PROCESS may be a process, a buffer, or the name of a process or buffer. 6112No arg or nil means current buffer's process. 6113Second arg CURRENT-GROUP non-nil means send signal to 6114the current process-group of the process's controlling terminal 6115rather than to the process's own process group. 6116If the process is a shell, this means interrupt current subjob 6117rather than the shell. 6118 6119If CURRENT-GROUP is `lambda', and if the shell owns the terminal, 6120don't send the signal. */) 6121 (process, current_group) 6122 Lisp_Object process, current_group; 6123{ 6124 process_send_signal (process, SIGINT, current_group, 0); 6125 return process; 6126} 6127 6128DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, 6129 doc: /* Kill process PROCESS. May be process or name of one. 6130See function `interrupt-process' for more details on usage. */) 6131 (process, current_group) 6132 Lisp_Object process, current_group; 6133{ 6134 process_send_signal (process, SIGKILL, current_group, 0); 6135 return process; 6136} 6137 6138DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0, 6139 doc: /* Send QUIT signal to process PROCESS. May be process or name of one. 6140See function `interrupt-process' for more details on usage. */) 6141 (process, current_group) 6142 Lisp_Object process, current_group; 6143{ 6144 process_send_signal (process, SIGQUIT, current_group, 0); 6145 return process; 6146} 6147 6148DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, 6149 doc: /* Stop process PROCESS. May be process or name of one. 6150See function `interrupt-process' for more details on usage. 6151If PROCESS is a network process, inhibit handling of incoming traffic. */) 6152 (process, current_group) 6153 Lisp_Object process, current_group; 6154{ 6155#ifdef HAVE_SOCKETS 6156 if (PROCESSP (process) && NETCONN_P (process)) 6157 { 6158 struct Lisp_Process *p; 6159 6160 p = XPROCESS (process); 6161 if (NILP (p->command) 6162 && XINT (p->infd) >= 0) 6163 { 6164 FD_CLR (XINT (p->infd), &input_wait_mask); 6165 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 6166 } 6167 p->command = Qt; 6168 return process; 6169 } 6170#endif 6171#ifndef SIGTSTP 6172 error ("No SIGTSTP support"); 6173#else 6174 process_send_signal (process, SIGTSTP, current_group, 0); 6175#endif 6176 return process; 6177} 6178 6179DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, 6180 doc: /* Continue process PROCESS. May be process or name of one. 6181See function `interrupt-process' for more details on usage. 6182If PROCESS is a network process, resume handling of incoming traffic. */) 6183 (process, current_group) 6184 Lisp_Object process, current_group; 6185{ 6186#ifdef HAVE_SOCKETS 6187 if (PROCESSP (process) && NETCONN_P (process)) 6188 { 6189 struct Lisp_Process *p; 6190 6191 p = XPROCESS (process); 6192 if (EQ (p->command, Qt) 6193 && XINT (p->infd) >= 0 6194 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) 6195 { 6196 FD_SET (XINT (p->infd), &input_wait_mask); 6197 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 6198 } 6199 p->command = Qnil; 6200 return process; 6201 } 6202#endif 6203#ifdef SIGCONT 6204 process_send_signal (process, SIGCONT, current_group, 0); 6205#else 6206 error ("No SIGCONT support"); 6207#endif 6208 return process; 6209} 6210 6211DEFUN ("signal-process", Fsignal_process, Ssignal_process, 6212 2, 2, "sProcess (name or number): \nnSignal code: ", 6213 doc: /* Send PROCESS the signal with code SIGCODE. 6214PROCESS may also be a number specifying the process id of the 6215process to signal; in this case, the process need not be a child of 6216this Emacs. 6217SIGCODE may be an integer, or a symbol whose name is a signal name. */) 6218 (process, sigcode) 6219 Lisp_Object process, sigcode; 6220{ 6221 pid_t pid; 6222 6223 if (INTEGERP (process)) 6224 { 6225 pid = XINT (process); 6226 goto got_it; 6227 } 6228 6229 if (FLOATP (process)) 6230 { 6231 pid = (pid_t) XFLOAT_DATA (process); 6232 goto got_it; 6233 } 6234 6235 if (STRINGP (process)) 6236 { 6237 Lisp_Object tem; 6238 if (tem = Fget_process (process), NILP (tem)) 6239 { 6240 pid = XINT (Fstring_to_number (process, make_number (10))); 6241 if (pid > 0) 6242 goto got_it; 6243 } 6244 process = tem; 6245 } 6246 else 6247 process = get_process (process); 6248 6249 if (NILP (process)) 6250 return process; 6251 6252 CHECK_PROCESS (process); 6253 pid = XPROCESS (process)->pid; 6254 if (pid <= 0) 6255 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); 6256 6257 got_it: 6258 6259#define parse_signal(NAME, VALUE) \ 6260 else if (!xstricmp (name, NAME)) \ 6261 XSETINT (sigcode, VALUE) 6262 6263 if (INTEGERP (sigcode)) 6264 ; 6265 else 6266 { 6267 unsigned char *name; 6268 6269 CHECK_SYMBOL (sigcode); 6270 name = SDATA (SYMBOL_NAME (sigcode)); 6271 6272 if (!strncmp(name, "SIG", 3) || !strncmp(name, "sig", 3)) 6273 name += 3; 6274 6275 if (0) 6276 ; 6277#ifdef SIGUSR1 6278 parse_signal ("usr1", SIGUSR1); 6279#endif 6280#ifdef SIGUSR2 6281 parse_signal ("usr2", SIGUSR2); 6282#endif 6283#ifdef SIGTERM 6284 parse_signal ("term", SIGTERM); 6285#endif 6286#ifdef SIGHUP 6287 parse_signal ("hup", SIGHUP); 6288#endif 6289#ifdef SIGINT 6290 parse_signal ("int", SIGINT); 6291#endif 6292#ifdef SIGQUIT 6293 parse_signal ("quit", SIGQUIT); 6294#endif 6295#ifdef SIGILL 6296 parse_signal ("ill", SIGILL); 6297#endif 6298#ifdef SIGABRT 6299 parse_signal ("abrt", SIGABRT); 6300#endif 6301#ifdef SIGEMT 6302 parse_signal ("emt", SIGEMT); 6303#endif 6304#ifdef SIGKILL 6305 parse_signal ("kill", SIGKILL); 6306#endif 6307#ifdef SIGFPE 6308 parse_signal ("fpe", SIGFPE); 6309#endif 6310#ifdef SIGBUS 6311 parse_signal ("bus", SIGBUS); 6312#endif 6313#ifdef SIGSEGV 6314 parse_signal ("segv", SIGSEGV); 6315#endif 6316#ifdef SIGSYS 6317 parse_signal ("sys", SIGSYS); 6318#endif 6319#ifdef SIGPIPE 6320 parse_signal ("pipe", SIGPIPE); 6321#endif 6322#ifdef SIGALRM 6323 parse_signal ("alrm", SIGALRM); 6324#endif 6325#ifdef SIGURG 6326 parse_signal ("urg", SIGURG); 6327#endif 6328#ifdef SIGSTOP 6329 parse_signal ("stop", SIGSTOP); 6330#endif 6331#ifdef SIGTSTP 6332 parse_signal ("tstp", SIGTSTP); 6333#endif 6334#ifdef SIGCONT 6335 parse_signal ("cont", SIGCONT); 6336#endif 6337#ifdef SIGCHLD 6338 parse_signal ("chld", SIGCHLD); 6339#endif 6340#ifdef SIGTTIN 6341 parse_signal ("ttin", SIGTTIN); 6342#endif 6343#ifdef SIGTTOU 6344 parse_signal ("ttou", SIGTTOU); 6345#endif 6346#ifdef SIGIO 6347 parse_signal ("io", SIGIO); 6348#endif 6349#ifdef SIGXCPU 6350 parse_signal ("xcpu", SIGXCPU); 6351#endif 6352#ifdef SIGXFSZ 6353 parse_signal ("xfsz", SIGXFSZ); 6354#endif 6355#ifdef SIGVTALRM 6356 parse_signal ("vtalrm", SIGVTALRM); 6357#endif 6358#ifdef SIGPROF 6359 parse_signal ("prof", SIGPROF); 6360#endif 6361#ifdef SIGWINCH 6362 parse_signal ("winch", SIGWINCH); 6363#endif 6364#ifdef SIGINFO 6365 parse_signal ("info", SIGINFO); 6366#endif 6367 else 6368 error ("Undefined signal name %s", name); 6369 } 6370 6371#undef parse_signal 6372 6373 return make_number (kill (pid, XINT (sigcode))); 6374} 6375 6376DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, 6377 doc: /* Make PROCESS see end-of-file in its input. 6378EOF comes after any text already sent to it. 6379PROCESS may be a process, a buffer, the name of a process or buffer, or 6380nil, indicating the current buffer's process. 6381If PROCESS is a network connection, or is a process communicating 6382through a pipe (as opposed to a pty), then you cannot send any more 6383text to PROCESS after you call this function. */) 6384 (process) 6385 Lisp_Object process; 6386{ 6387 Lisp_Object proc; 6388 struct coding_system *coding; 6389 6390 if (DATAGRAM_CONN_P (process)) 6391 return process; 6392 6393 proc = get_process (process); 6394 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; 6395 6396 /* Make sure the process is really alive. */ 6397 if (XPROCESS (proc)->raw_status_new) 6398 update_status (XPROCESS (proc)); 6399 if (! EQ (XPROCESS (proc)->status, Qrun)) 6400 error ("Process %s not running", SDATA (XPROCESS (proc)->name)); 6401 6402 if (CODING_REQUIRE_FLUSHING (coding)) 6403 { 6404 coding->mode |= CODING_MODE_LAST_BLOCK; 6405 send_process (proc, "", 0, Qnil); 6406 } 6407 6408#ifdef VMS 6409 send_process (proc, "\032", 1, Qnil); /* ^z */ 6410#else 6411 if (!NILP (XPROCESS (proc)->pty_flag)) 6412 send_process (proc, "\004", 1, Qnil); 6413 else 6414 { 6415 int old_outfd, new_outfd; 6416 6417#ifdef HAVE_SHUTDOWN 6418 /* If this is a network connection, or socketpair is used 6419 for communication with the subprocess, call shutdown to cause EOF. 6420 (In some old system, shutdown to socketpair doesn't work. 6421 Then we just can't win.) */ 6422 if (XPROCESS (proc)->pid == 0 6423 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd)) 6424 shutdown (XINT (XPROCESS (proc)->outfd), 1); 6425 /* In case of socketpair, outfd == infd, so don't close it. */ 6426 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd)) 6427 emacs_close (XINT (XPROCESS (proc)->outfd)); 6428#else /* not HAVE_SHUTDOWN */ 6429 emacs_close (XINT (XPROCESS (proc)->outfd)); 6430#endif /* not HAVE_SHUTDOWN */ 6431 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0); 6432 if (new_outfd < 0) 6433 abort (); 6434 old_outfd = XINT (XPROCESS (proc)->outfd); 6435 6436 if (!proc_encode_coding_system[new_outfd]) 6437 proc_encode_coding_system[new_outfd] 6438 = (struct coding_system *) xmalloc (sizeof (struct coding_system)); 6439 bcopy (proc_encode_coding_system[old_outfd], 6440 proc_encode_coding_system[new_outfd], 6441 sizeof (struct coding_system)); 6442 bzero (proc_encode_coding_system[old_outfd], 6443 sizeof (struct coding_system)); 6444 6445 XSETINT (XPROCESS (proc)->outfd, new_outfd); 6446 } 6447#endif /* VMS */ 6448 return process; 6449} 6450 6451/* Kill all processes associated with `buffer'. 6452 If `buffer' is nil, kill all processes */ 6453 6454void 6455kill_buffer_processes (buffer) 6456 Lisp_Object buffer; 6457{ 6458 Lisp_Object tail, proc; 6459 6460 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) 6461 { 6462 proc = XCDR (XCAR (tail)); 6463 if (GC_PROCESSP (proc) 6464 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) 6465 { 6466 if (NETCONN_P (proc)) 6467 Fdelete_process (proc); 6468 else if (XINT (XPROCESS (proc)->infd) >= 0) 6469 process_send_signal (proc, SIGHUP, Qnil, 1); 6470 } 6471 } 6472} 6473 6474/* On receipt of a signal that a child status has changed, loop asking 6475 about children with changed statuses until the system says there 6476 are no more. 6477 6478 All we do is change the status; we do not run sentinels or print 6479 notifications. That is saved for the next time keyboard input is 6480 done, in order to avoid timing errors. 6481 6482 ** WARNING: this can be called during garbage collection. 6483 Therefore, it must not be fooled by the presence of mark bits in 6484 Lisp objects. 6485 6486 ** USG WARNING: Although it is not obvious from the documentation 6487 in signal(2), on a USG system the SIGCLD handler MUST NOT call 6488 signal() before executing at least one wait(), otherwise the 6489 handler will be called again, resulting in an infinite loop. The 6490 relevant portion of the documentation reads "SIGCLD signals will be 6491 queued and the signal-catching function will be continually 6492 reentered until the queue is empty". Invoking signal() causes the 6493 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems 6494 Inc. 6495 6496 ** Malloc WARNING: This should never call malloc either directly or 6497 indirectly; if it does, that is a bug */ 6498 6499#ifdef SIGCHLD 6500SIGTYPE 6501sigchld_handler (signo) 6502 int signo; 6503{ 6504 int old_errno = errno; 6505 Lisp_Object proc; 6506 register struct Lisp_Process *p; 6507 extern EMACS_TIME *input_available_clear_time; 6508 6509 SIGNAL_THREAD_CHECK (signo); 6510 6511#ifdef BSD4_1 6512 extern int sigheld; 6513 sigheld |= sigbit (SIGCHLD); 6514#endif 6515 6516 while (1) 6517 { 6518 pid_t pid; 6519 WAITTYPE w; 6520 Lisp_Object tail; 6521 6522#ifdef WNOHANG 6523#ifndef WUNTRACED 6524#define WUNTRACED 0 6525#endif /* no WUNTRACED */ 6526 /* Keep trying to get a status until we get a definitive result. */ 6527 do 6528 { 6529 errno = 0; 6530 pid = wait3 (&w, WNOHANG | WUNTRACED, 0); 6531 } 6532 while (pid < 0 && errno == EINTR); 6533 6534 if (pid <= 0) 6535 { 6536 /* PID == 0 means no processes found, PID == -1 means a real 6537 failure. We have done all our job, so return. */ 6538 6539 /* USG systems forget handlers when they are used; 6540 must reestablish each time */ 6541#if defined (USG) && !defined (POSIX_SIGNALS) 6542 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */ 6543#endif 6544#ifdef BSD4_1 6545 sigheld &= ~sigbit (SIGCHLD); 6546 sigrelse (SIGCHLD); 6547#endif 6548 errno = old_errno; 6549 return; 6550 } 6551#else 6552 pid = wait (&w); 6553#endif /* no WNOHANG */ 6554 6555 /* Find the process that signaled us, and record its status. */ 6556 6557 /* The process can have been deleted by Fdelete_process. */ 6558 for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail)) 6559 { 6560 Lisp_Object xpid = XCAR (tail); 6561 if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid)) 6562 || (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid))) 6563 { 6564 XSETCAR (tail, Qnil); 6565 goto sigchld_end_of_loop; 6566 } 6567 } 6568 6569 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */ 6570 p = 0; 6571 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) 6572 { 6573 proc = XCDR (XCAR (tail)); 6574 p = XPROCESS (proc); 6575 if (GC_EQ (p->childp, Qt) && p->pid == pid) 6576 break; 6577 p = 0; 6578 } 6579 6580 /* Look for an asynchronous process whose pid hasn't been filled 6581 in yet. */ 6582 if (p == 0) 6583 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) 6584 { 6585 proc = XCDR (XCAR (tail)); 6586 p = XPROCESS (proc); 6587 if (p->pid == -1) 6588 break; 6589 p = 0; 6590 } 6591 6592 /* Change the status of the process that was found. */ 6593 if (p != 0) 6594 { 6595 union { int i; WAITTYPE wt; } u; 6596 int clear_desc_flag = 0; 6597 6598 XSETINT (p->tick, ++process_tick); 6599 u.wt = w; 6600 p->raw_status = u.i; 6601 p->raw_status_new = 1; 6602 6603 /* If process has terminated, stop waiting for its output. */ 6604 if ((WIFSIGNALED (w) || WIFEXITED (w)) 6605 && XINT (p->infd) >= 0) 6606 clear_desc_flag = 1; 6607 6608 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ 6609 if (clear_desc_flag) 6610 { 6611 FD_CLR (XINT (p->infd), &input_wait_mask); 6612 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 6613 } 6614 6615 /* Tell wait_reading_process_output that it needs to wake up and 6616 look around. */ 6617 if (input_available_clear_time) 6618 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); 6619 } 6620 6621 /* There was no asynchronous process found for that pid: we have 6622 a synchronous process. */ 6623 else 6624 { 6625 synch_process_alive = 0; 6626 6627 /* Report the status of the synchronous process. */ 6628 if (WIFEXITED (w)) 6629 synch_process_retcode = WRETCODE (w); 6630 else if (WIFSIGNALED (w)) 6631 synch_process_termsig = WTERMSIG (w); 6632 6633 /* Tell wait_reading_process_output that it needs to wake up and 6634 look around. */ 6635 if (input_available_clear_time) 6636 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); 6637 } 6638 6639 sigchld_end_of_loop: 6640 ; 6641 6642 /* On some systems, we must return right away. 6643 If any more processes want to signal us, we will 6644 get another signal. 6645 Otherwise (on systems that have WNOHANG), loop around 6646 to use up all the processes that have something to tell us. */ 6647#if (defined WINDOWSNT \ 6648 || (defined USG && !defined GNU_LINUX \ 6649 && !(defined HPUX && defined WNOHANG))) 6650#if defined (USG) && ! defined (POSIX_SIGNALS) 6651 signal (signo, sigchld_handler); 6652#endif 6653 errno = old_errno; 6654 return; 6655#endif /* USG, but not HPUX with WNOHANG */ 6656 } 6657} 6658#endif /* SIGCHLD */ 6659 6660 6661static Lisp_Object 6662exec_sentinel_unwind (data) 6663 Lisp_Object data; 6664{ 6665 XPROCESS (XCAR (data))->sentinel = XCDR (data); 6666 return Qnil; 6667} 6668 6669static Lisp_Object 6670exec_sentinel_error_handler (error) 6671 Lisp_Object error; 6672{ 6673 cmd_error_internal (error, "error in process sentinel: "); 6674 Vinhibit_quit = Qt; 6675 update_echo_area (); 6676 Fsleep_for (make_number (2), Qnil); 6677 return Qt; 6678} 6679 6680static void 6681exec_sentinel (proc, reason) 6682 Lisp_Object proc, reason; 6683{ 6684 Lisp_Object sentinel, obuffer, odeactivate, okeymap; 6685 register struct Lisp_Process *p = XPROCESS (proc); 6686 int count = SPECPDL_INDEX (); 6687 int outer_running_asynch_code = running_asynch_code; 6688 int waiting = waiting_for_user_input_p; 6689 6690 if (inhibit_sentinels) 6691 return; 6692 6693 /* No need to gcpro these, because all we do with them later 6694 is test them for EQness, and none of them should be a string. */ 6695 odeactivate = Vdeactivate_mark; 6696 XSETBUFFER (obuffer, current_buffer); 6697 okeymap = current_buffer->keymap; 6698 6699 sentinel = p->sentinel; 6700 if (NILP (sentinel)) 6701 return; 6702 6703 /* Zilch the sentinel while it's running, to avoid recursive invocations; 6704 assure that it gets restored no matter how the sentinel exits. */ 6705 p->sentinel = Qnil; 6706 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel)); 6707 /* Inhibit quit so that random quits don't screw up a running filter. */ 6708 specbind (Qinhibit_quit, Qt); 6709 specbind (Qlast_nonmenu_event, Qt); 6710 6711 /* In case we get recursively called, 6712 and we already saved the match data nonrecursively, 6713 save the same match data in safely recursive fashion. */ 6714 if (outer_running_asynch_code) 6715 { 6716 Lisp_Object tem; 6717 tem = Fmatch_data (Qnil, Qnil, Qnil); 6718 restore_search_regs (); 6719 record_unwind_save_match_data (); 6720 Fset_match_data (tem, Qt); 6721 } 6722 6723 /* For speed, if a search happens within this code, 6724 save the match data in a special nonrecursive fashion. */ 6725 running_asynch_code = 1; 6726 6727 internal_condition_case_1 (read_process_output_call, 6728 Fcons (sentinel, 6729 Fcons (proc, Fcons (reason, Qnil))), 6730 !NILP (Vdebug_on_error) ? Qnil : Qerror, 6731 exec_sentinel_error_handler); 6732 6733 /* If we saved the match data nonrecursively, restore it now. */ 6734 restore_search_regs (); 6735 running_asynch_code = outer_running_asynch_code; 6736 6737 Vdeactivate_mark = odeactivate; 6738 6739 /* Restore waiting_for_user_input_p as it was 6740 when we were called, in case the filter clobbered it. */ 6741 waiting_for_user_input_p = waiting; 6742 6743#if 0 6744 if (! EQ (Fcurrent_buffer (), obuffer) 6745 || ! EQ (current_buffer->keymap, okeymap)) 6746#endif 6747 /* But do it only if the caller is actually going to read events. 6748 Otherwise there's no need to make him wake up, and it could 6749 cause trouble (for example it would make sit_for return). */ 6750 if (waiting_for_user_input_p == -1) 6751 record_asynch_buffer_change (); 6752 6753 unbind_to (count, Qnil); 6754} 6755 6756/* Report all recent events of a change in process status 6757 (either run the sentinel or output a message). 6758 This is usually done while Emacs is waiting for keyboard input 6759 but can be done at other times. */ 6760 6761static void 6762status_notify (deleting_process) 6763 struct Lisp_Process *deleting_process; 6764{ 6765 register Lisp_Object proc, buffer; 6766 Lisp_Object tail, msg; 6767 struct gcpro gcpro1, gcpro2; 6768 6769 tail = Qnil; 6770 msg = Qnil; 6771 /* We need to gcpro tail; if read_process_output calls a filter 6772 which deletes a process and removes the cons to which tail points 6773 from Vprocess_alist, and then causes a GC, tail is an unprotected 6774 reference. */ 6775 GCPRO2 (tail, msg); 6776 6777 /* Set this now, so that if new processes are created by sentinels 6778 that we run, we get called again to handle their status changes. */ 6779 update_tick = process_tick; 6780 6781 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) 6782 { 6783 Lisp_Object symbol; 6784 register struct Lisp_Process *p; 6785 6786 proc = Fcdr (Fcar (tail)); 6787 p = XPROCESS (proc); 6788 6789 if (XINT (p->tick) != XINT (p->update_tick)) 6790 { 6791 XSETINT (p->update_tick, XINT (p->tick)); 6792 6793 /* If process is still active, read any output that remains. */ 6794 while (! EQ (p->filter, Qt) 6795 && ! EQ (p->status, Qconnect) 6796 && ! EQ (p->status, Qlisten) 6797 && ! EQ (p->command, Qt) /* Network process not stopped. */ 6798 && XINT (p->infd) >= 0 6799 && p != deleting_process 6800 && read_process_output (proc, XINT (p->infd)) > 0); 6801 6802 buffer = p->buffer; 6803 6804 /* Get the text to use for the message. */ 6805 if (p->raw_status_new) 6806 update_status (p); 6807 msg = status_message (p); 6808 6809 /* If process is terminated, deactivate it or delete it. */ 6810 symbol = p->status; 6811 if (CONSP (p->status)) 6812 symbol = XCAR (p->status); 6813 6814 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) 6815 || EQ (symbol, Qclosed)) 6816 { 6817 if (delete_exited_processes) 6818 remove_process (proc); 6819 else 6820 deactivate_process (proc); 6821 } 6822 6823 /* The actions above may have further incremented p->tick. 6824 So set p->update_tick again 6825 so that an error in the sentinel will not cause 6826 this code to be run again. */ 6827 XSETINT (p->update_tick, XINT (p->tick)); 6828 /* Now output the message suitably. */ 6829 if (!NILP (p->sentinel)) 6830 exec_sentinel (proc, msg); 6831 /* Don't bother with a message in the buffer 6832 when a process becomes runnable. */ 6833 else if (!EQ (symbol, Qrun) && !NILP (buffer)) 6834 { 6835 Lisp_Object ro, tem; 6836 struct buffer *old = current_buffer; 6837 int opoint, opoint_byte; 6838 int before, before_byte; 6839 6840 ro = XBUFFER (buffer)->read_only; 6841 6842 /* Avoid error if buffer is deleted 6843 (probably that's why the process is dead, too) */ 6844 if (NILP (XBUFFER (buffer)->name)) 6845 continue; 6846 Fset_buffer (buffer); 6847 6848 opoint = PT; 6849 opoint_byte = PT_BYTE; 6850 /* Insert new output into buffer 6851 at the current end-of-output marker, 6852 thus preserving logical ordering of input and output. */ 6853 if (XMARKER (p->mark)->buffer) 6854 Fgoto_char (p->mark); 6855 else 6856 SET_PT_BOTH (ZV, ZV_BYTE); 6857 6858 before = PT; 6859 before_byte = PT_BYTE; 6860 6861 tem = current_buffer->read_only; 6862 current_buffer->read_only = Qnil; 6863 insert_string ("\nProcess "); 6864 Finsert (1, &p->name); 6865 insert_string (" "); 6866 Finsert (1, &msg); 6867 current_buffer->read_only = tem; 6868 set_marker_both (p->mark, p->buffer, PT, PT_BYTE); 6869 6870 if (opoint >= before) 6871 SET_PT_BOTH (opoint + (PT - before), 6872 opoint_byte + (PT_BYTE - before_byte)); 6873 else 6874 SET_PT_BOTH (opoint, opoint_byte); 6875 6876 set_buffer_internal (old); 6877 } 6878 } 6879 } /* end for */ 6880 6881 update_mode_lines++; /* in case buffers use %s in mode-line-format */ 6882 redisplay_preserve_echo_area (13); 6883 6884 UNGCPRO; 6885} 6886 6887 6888DEFUN ("set-process-coding-system", Fset_process_coding_system, 6889 Sset_process_coding_system, 1, 3, 0, 6890 doc: /* Set coding systems of PROCESS to DECODING and ENCODING. 6891DECODING will be used to decode subprocess output and ENCODING to 6892encode subprocess input. */) 6893 (process, decoding, encoding) 6894 register Lisp_Object process, decoding, encoding; 6895{ 6896 register struct Lisp_Process *p; 6897 6898 CHECK_PROCESS (process); 6899 p = XPROCESS (process); 6900 if (XINT (p->infd) < 0) 6901 error ("Input file descriptor of %s closed", SDATA (p->name)); 6902 if (XINT (p->outfd) < 0) 6903 error ("Output file descriptor of %s closed", SDATA (p->name)); 6904 Fcheck_coding_system (decoding); 6905 Fcheck_coding_system (encoding); 6906 6907 p->decode_coding_system = decoding; 6908 p->encode_coding_system = encoding; 6909 setup_process_coding_systems (process); 6910 6911 return Qnil; 6912} 6913 6914DEFUN ("process-coding-system", 6915 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0, 6916 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */) 6917 (process) 6918 register Lisp_Object process; 6919{ 6920 CHECK_PROCESS (process); 6921 return Fcons (XPROCESS (process)->decode_coding_system, 6922 XPROCESS (process)->encode_coding_system); 6923} 6924 6925DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte, 6926 Sset_process_filter_multibyte, 2, 2, 0, 6927 doc: /* Set multibyteness of the strings given to PROCESS's filter. 6928If FLAG is non-nil, the filter is given multibyte strings. 6929If FLAG is nil, the filter is given unibyte strings. In this case, 6930all character code conversion except for end-of-line conversion is 6931suppressed. */) 6932 (process, flag) 6933 Lisp_Object process, flag; 6934{ 6935 register struct Lisp_Process *p; 6936 6937 CHECK_PROCESS (process); 6938 p = XPROCESS (process); 6939 p->filter_multibyte = flag; 6940 setup_process_coding_systems (process); 6941 6942 return Qnil; 6943} 6944 6945DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, 6946 Sprocess_filter_multibyte_p, 1, 1, 0, 6947 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/) 6948 (process) 6949 Lisp_Object process; 6950{ 6951 register struct Lisp_Process *p; 6952 6953 CHECK_PROCESS (process); 6954 p = XPROCESS (process); 6955 6956 return (NILP (p->filter_multibyte) ? Qnil : Qt); 6957} 6958 6959 6960 6961/* The first time this is called, assume keyboard input comes from DESC 6962 instead of from where we used to expect it. 6963 Subsequent calls mean assume input keyboard can come from DESC 6964 in addition to other places. */ 6965 6966static int add_keyboard_wait_descriptor_called_flag; 6967 6968void 6969add_keyboard_wait_descriptor (desc) 6970 int desc; 6971{ 6972 if (! add_keyboard_wait_descriptor_called_flag) 6973 FD_CLR (0, &input_wait_mask); 6974 add_keyboard_wait_descriptor_called_flag = 1; 6975 FD_SET (desc, &input_wait_mask); 6976 FD_SET (desc, &non_process_wait_mask); 6977 if (desc > max_keyboard_desc) 6978 max_keyboard_desc = desc; 6979} 6980 6981/* From now on, do not expect DESC to give keyboard input. */ 6982 6983void 6984delete_keyboard_wait_descriptor (desc) 6985 int desc; 6986{ 6987 int fd; 6988 int lim = max_keyboard_desc; 6989 6990 FD_CLR (desc, &input_wait_mask); 6991 FD_CLR (desc, &non_process_wait_mask); 6992 6993 if (desc == max_keyboard_desc) 6994 for (fd = 0; fd < lim; fd++) 6995 if (FD_ISSET (fd, &input_wait_mask) 6996 && !FD_ISSET (fd, &non_keyboard_wait_mask)) 6997 max_keyboard_desc = fd; 6998} 6999 7000/* Return nonzero if *MASK has a bit set 7001 that corresponds to one of the keyboard input descriptors. */ 7002 7003static int 7004keyboard_bit_set (mask) 7005 SELECT_TYPE *mask; 7006{ 7007 int fd; 7008 7009 for (fd = 0; fd <= max_keyboard_desc; fd++) 7010 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask) 7011 && !FD_ISSET (fd, &non_keyboard_wait_mask)) 7012 return 1; 7013 7014 return 0; 7015} 7016 7017void 7018init_process () 7019{ 7020 register int i; 7021 7022 inhibit_sentinels = 0; 7023 7024#ifdef SIGCHLD 7025#ifndef CANNOT_DUMP 7026 if (! noninteractive || initialized) 7027#endif 7028 signal (SIGCHLD, sigchld_handler); 7029#endif 7030 7031 FD_ZERO (&input_wait_mask); 7032 FD_ZERO (&non_keyboard_wait_mask); 7033 FD_ZERO (&non_process_wait_mask); 7034 max_process_desc = 0; 7035 7036#ifdef NON_BLOCKING_CONNECT 7037 FD_ZERO (&connect_wait_mask); 7038 num_pending_connects = 0; 7039#endif 7040 7041#ifdef ADAPTIVE_READ_BUFFERING 7042 process_output_delay_count = 0; 7043 process_output_skip = 0; 7044#endif 7045 7046 FD_SET (0, &input_wait_mask); 7047 7048 Vprocess_alist = Qnil; 7049#ifdef SIGCHLD 7050 deleted_pid_list = Qnil; 7051#endif 7052 for (i = 0; i < MAXDESC; i++) 7053 { 7054 chan_process[i] = Qnil; 7055 proc_buffered_char[i] = -1; 7056 } 7057 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system); 7058 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system); 7059#ifdef DATAGRAM_SOCKETS 7060 bzero (datagram_address, sizeof datagram_address); 7061#endif 7062 7063#ifdef HAVE_SOCKETS 7064 { 7065 Lisp_Object subfeatures = Qnil; 7066 struct socket_options *sopt; 7067 7068#define ADD_SUBFEATURE(key, val) \ 7069 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures) 7070 7071#ifdef NON_BLOCKING_CONNECT 7072 ADD_SUBFEATURE (QCnowait, Qt); 7073#endif 7074#ifdef DATAGRAM_SOCKETS 7075 ADD_SUBFEATURE (QCtype, Qdatagram); 7076#endif 7077#ifdef HAVE_LOCAL_SOCKETS 7078 ADD_SUBFEATURE (QCfamily, Qlocal); 7079#endif 7080 ADD_SUBFEATURE (QCfamily, Qipv4); 7081#ifdef AF_INET6 7082 ADD_SUBFEATURE (QCfamily, Qipv6); 7083#endif 7084#ifdef HAVE_GETSOCKNAME 7085 ADD_SUBFEATURE (QCservice, Qt); 7086#endif 7087#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY)) 7088 ADD_SUBFEATURE (QCserver, Qt); 7089#endif 7090 7091 for (sopt = socket_options; sopt->name; sopt++) 7092 subfeatures = Fcons (intern (sopt->name), subfeatures); 7093 7094 Fprovide (intern ("make-network-process"), subfeatures); 7095 } 7096#endif /* HAVE_SOCKETS */ 7097 7098#if defined (DARWIN) || defined (MAC_OSX) 7099 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive 7100 processes. As such, we only change the default value. */ 7101 if (initialized) 7102 { 7103 char *release = get_operating_system_release(); 7104 if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION 7105 && release[1] == '.')) { 7106 Vprocess_connection_type = Qnil; 7107 } 7108 } 7109#endif 7110} 7111 7112void 7113syms_of_process () 7114{ 7115 Qprocessp = intern ("processp"); 7116 staticpro (&Qprocessp); 7117 Qrun = intern ("run"); 7118 staticpro (&Qrun); 7119 Qstop = intern ("stop"); 7120 staticpro (&Qstop); 7121 Qsignal = intern ("signal"); 7122 staticpro (&Qsignal); 7123 7124 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it 7125 here again. 7126 7127 Qexit = intern ("exit"); 7128 staticpro (&Qexit); */ 7129 7130 Qopen = intern ("open"); 7131 staticpro (&Qopen); 7132 Qclosed = intern ("closed"); 7133 staticpro (&Qclosed); 7134 Qconnect = intern ("connect"); 7135 staticpro (&Qconnect); 7136 Qfailed = intern ("failed"); 7137 staticpro (&Qfailed); 7138 Qlisten = intern ("listen"); 7139 staticpro (&Qlisten); 7140 Qlocal = intern ("local"); 7141 staticpro (&Qlocal); 7142 Qipv4 = intern ("ipv4"); 7143 staticpro (&Qipv4); 7144#ifdef AF_INET6 7145 Qipv6 = intern ("ipv6"); 7146 staticpro (&Qipv6); 7147#endif 7148 Qdatagram = intern ("datagram"); 7149 staticpro (&Qdatagram); 7150 7151 QCname = intern (":name"); 7152 staticpro (&QCname); 7153 QCbuffer = intern (":buffer"); 7154 staticpro (&QCbuffer); 7155 QChost = intern (":host"); 7156 staticpro (&QChost); 7157 QCservice = intern (":service"); 7158 staticpro (&QCservice); 7159 QCtype = intern (":type"); 7160 staticpro (&QCtype); 7161 QClocal = intern (":local"); 7162 staticpro (&QClocal); 7163 QCremote = intern (":remote"); 7164 staticpro (&QCremote); 7165 QCcoding = intern (":coding"); 7166 staticpro (&QCcoding); 7167 QCserver = intern (":server"); 7168 staticpro (&QCserver); 7169 QCnowait = intern (":nowait"); 7170 staticpro (&QCnowait); 7171 QCsentinel = intern (":sentinel"); 7172 staticpro (&QCsentinel); 7173 QClog = intern (":log"); 7174 staticpro (&QClog); 7175 QCnoquery = intern (":noquery"); 7176 staticpro (&QCnoquery); 7177 QCstop = intern (":stop"); 7178 staticpro (&QCstop); 7179 QCoptions = intern (":options"); 7180 staticpro (&QCoptions); 7181 QCplist = intern (":plist"); 7182 staticpro (&QCplist); 7183 QCfilter_multibyte = intern (":filter-multibyte"); 7184 staticpro (&QCfilter_multibyte); 7185 7186 Qlast_nonmenu_event = intern ("last-nonmenu-event"); 7187 staticpro (&Qlast_nonmenu_event); 7188 7189 staticpro (&Vprocess_alist); 7190#ifdef SIGCHLD 7191 staticpro (&deleted_pid_list); 7192#endif 7193 7194 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, 7195 doc: /* *Non-nil means delete processes immediately when they exit. 7196A value of nil means don't delete them until `list-processes' is run. */); 7197 7198 delete_exited_processes = 1; 7199 7200 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, 7201 doc: /* Control type of device used to communicate with subprocesses. 7202Values are nil to use a pipe, or t or `pty' to use a pty. 7203The value has no effect if the system has no ptys or if all ptys are busy: 7204then a pipe is used in any case. 7205The value takes effect when `start-process' is called. */); 7206 Vprocess_connection_type = Qt; 7207 7208#ifdef ADAPTIVE_READ_BUFFERING 7209 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering, 7210 doc: /* If non-nil, improve receive buffering by delaying after short reads. 7211On some systems, when Emacs reads the output from a subprocess, the output data 7212is read in very small blocks, potentially resulting in very poor performance. 7213This behavior can be remedied to some extent by setting this variable to a 7214non-nil value, as it will automatically delay reading from such processes, to 7215allow them to produce more output before Emacs tries to read it. 7216If the value is t, the delay is reset after each write to the process; any other 7217non-nil value means that the delay is not reset on write. 7218The variable takes effect when `start-process' is called. */); 7219 Vprocess_adaptive_read_buffering = Qt; 7220#endif 7221 7222 defsubr (&Sprocessp); 7223 defsubr (&Sget_process); 7224 defsubr (&Sget_buffer_process); 7225 defsubr (&Sdelete_process); 7226 defsubr (&Sprocess_status); 7227 defsubr (&Sprocess_exit_status); 7228 defsubr (&Sprocess_id); 7229 defsubr (&Sprocess_name); 7230 defsubr (&Sprocess_tty_name); 7231 defsubr (&Sprocess_command); 7232 defsubr (&Sset_process_buffer); 7233 defsubr (&Sprocess_buffer); 7234 defsubr (&Sprocess_mark); 7235 defsubr (&Sset_process_filter); 7236 defsubr (&Sprocess_filter); 7237 defsubr (&Sset_process_sentinel); 7238 defsubr (&Sprocess_sentinel); 7239 defsubr (&Sset_process_window_size); 7240 defsubr (&Sset_process_inherit_coding_system_flag); 7241 defsubr (&Sprocess_inherit_coding_system_flag); 7242 defsubr (&Sset_process_query_on_exit_flag); 7243 defsubr (&Sprocess_query_on_exit_flag); 7244 defsubr (&Sprocess_contact); 7245 defsubr (&Sprocess_plist); 7246 defsubr (&Sset_process_plist); 7247 defsubr (&Slist_processes); 7248 defsubr (&Sprocess_list); 7249 defsubr (&Sstart_process); 7250#ifdef HAVE_SOCKETS 7251 defsubr (&Sset_network_process_option); 7252 defsubr (&Smake_network_process); 7253 defsubr (&Sformat_network_address); 7254#endif /* HAVE_SOCKETS */ 7255#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) 7256#ifdef SIOCGIFCONF 7257 defsubr (&Snetwork_interface_list); 7258#endif 7259#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS) 7260 defsubr (&Snetwork_interface_info); 7261#endif 7262#endif /* HAVE_SOCKETS ... */ 7263#ifdef DATAGRAM_SOCKETS 7264 defsubr (&Sprocess_datagram_address); 7265 defsubr (&Sset_process_datagram_address); 7266#endif 7267 defsubr (&Saccept_process_output); 7268 defsubr (&Sprocess_send_region); 7269 defsubr (&Sprocess_send_string); 7270 defsubr (&Sinterrupt_process); 7271 defsubr (&Skill_process); 7272 defsubr (&Squit_process); 7273 defsubr (&Sstop_process); 7274 defsubr (&Scontinue_process); 7275 defsubr (&Sprocess_running_child_p); 7276 defsubr (&Sprocess_send_eof); 7277 defsubr (&Ssignal_process); 7278 defsubr (&Swaiting_for_user_input_p); 7279/* defsubr (&Sprocess_connection); */ 7280 defsubr (&Sset_process_coding_system); 7281 defsubr (&Sprocess_coding_system); 7282 defsubr (&Sset_process_filter_multibyte); 7283 defsubr (&Sprocess_filter_multibyte_p); 7284} 7285 7286 7287#else /* not subprocesses */ 7288 7289#include <sys/types.h> 7290#include <errno.h> 7291 7292#include "lisp.h" 7293#include "systime.h" 7294#include "charset.h" 7295#include "coding.h" 7296#include "termopts.h" 7297#include "sysselect.h" 7298 7299extern int frame_garbaged; 7300 7301extern EMACS_TIME timer_check (); 7302extern int timers_run; 7303 7304Lisp_Object QCtype; 7305 7306/* As described above, except assuming that there are no subprocesses: 7307 7308 Wait for timeout to elapse and/or keyboard input to be available. 7309 7310 time_limit is: 7311 timeout in seconds, or 7312 zero for no limit, or 7313 -1 means gobble data immediately available but don't wait for any. 7314 7315 read_kbd is a Lisp_Object: 7316 0 to ignore keyboard input, or 7317 1 to return when input is available, or 7318 -1 means caller will actually read the input, so don't throw to 7319 the quit handler. 7320 7321 see full version for other parameters. We know that wait_proc will 7322 always be NULL, since `subprocesses' isn't defined. 7323 7324 do_display != 0 means redisplay should be done to show subprocess 7325 output that arrives. 7326 7327 Return true iff we received input from any process. */ 7328 7329int 7330wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, 7331 wait_for_cell, wait_proc, just_wait_proc) 7332 int time_limit, microsecs, read_kbd, do_display; 7333 Lisp_Object wait_for_cell; 7334 struct Lisp_Process *wait_proc; 7335 int just_wait_proc; 7336{ 7337 register int nfds; 7338 EMACS_TIME end_time, timeout; 7339 SELECT_TYPE waitchannels; 7340 int xerrno; 7341 7342 /* What does time_limit really mean? */ 7343 if (time_limit || microsecs) 7344 { 7345 EMACS_GET_TIME (end_time); 7346 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); 7347 EMACS_ADD_TIME (end_time, end_time, timeout); 7348 } 7349 7350 /* Turn off periodic alarms (in case they are in use) 7351 and then turn off any other atimers, 7352 because the select emulator uses alarms. */ 7353 stop_polling (); 7354 turn_on_atimers (0); 7355 7356 while (1) 7357 { 7358 int timeout_reduced_for_timers = 0; 7359 7360 /* If calling from keyboard input, do not quit 7361 since we want to return C-g as an input character. 7362 Otherwise, do pending quit if requested. */ 7363 if (read_kbd >= 0) 7364 QUIT; 7365 7366 /* Exit now if the cell we're waiting for became non-nil. */ 7367 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 7368 break; 7369 7370 /* Compute time from now till when time limit is up */ 7371 /* Exit if already run out */ 7372 if (time_limit == -1) 7373 { 7374 /* -1 specified for timeout means 7375 gobble output available now 7376 but don't wait at all. */ 7377 7378 EMACS_SET_SECS_USECS (timeout, 0, 0); 7379 } 7380 else if (time_limit || microsecs) 7381 { 7382 EMACS_GET_TIME (timeout); 7383 EMACS_SUB_TIME (timeout, end_time, timeout); 7384 if (EMACS_TIME_NEG_P (timeout)) 7385 break; 7386 } 7387 else 7388 { 7389 EMACS_SET_SECS_USECS (timeout, 100000, 0); 7390 } 7391 7392 /* If our caller will not immediately handle keyboard events, 7393 run timer events directly. 7394 (Callers that will immediately read keyboard events 7395 call timer_delay on their own.) */ 7396 if (NILP (wait_for_cell)) 7397 { 7398 EMACS_TIME timer_delay; 7399 7400 do 7401 { 7402 int old_timers_run = timers_run; 7403 timer_delay = timer_check (1); 7404 if (timers_run != old_timers_run && do_display) 7405 /* We must retry, since a timer may have requeued itself 7406 and that could alter the time delay. */ 7407 redisplay_preserve_echo_area (14); 7408 else 7409 break; 7410 } 7411 while (!detect_input_pending ()); 7412 7413 /* If there is unread keyboard input, also return. */ 7414 if (read_kbd != 0 7415 && requeued_events_pending_p ()) 7416 break; 7417 7418 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1) 7419 { 7420 EMACS_TIME difference; 7421 EMACS_SUB_TIME (difference, timer_delay, timeout); 7422 if (EMACS_TIME_NEG_P (difference)) 7423 { 7424 timeout = timer_delay; 7425 timeout_reduced_for_timers = 1; 7426 } 7427 } 7428 } 7429 7430 /* Cause C-g and alarm signals to take immediate action, 7431 and cause input available signals to zero out timeout. */ 7432 if (read_kbd < 0) 7433 set_waiting_for_input (&timeout); 7434 7435 /* Wait till there is something to do. */ 7436 7437 if (! read_kbd && NILP (wait_for_cell)) 7438 FD_ZERO (&waitchannels); 7439 else 7440 FD_SET (0, &waitchannels); 7441 7442 /* If a frame has been newly mapped and needs updating, 7443 reprocess its display stuff. */ 7444 if (frame_garbaged && do_display) 7445 { 7446 clear_waiting_for_input (); 7447 redisplay_preserve_echo_area (15); 7448 if (read_kbd < 0) 7449 set_waiting_for_input (&timeout); 7450 } 7451 7452 if (read_kbd && detect_input_pending ()) 7453 { 7454 nfds = 0; 7455 FD_ZERO (&waitchannels); 7456 } 7457 else 7458 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0, 7459 &timeout); 7460 7461 xerrno = errno; 7462 7463 /* Make C-g and alarm signals set flags again */ 7464 clear_waiting_for_input (); 7465 7466 /* If we woke up due to SIGWINCH, actually change size now. */ 7467 do_pending_window_change (0); 7468 7469 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers) 7470 /* We waited the full specified time, so return now. */ 7471 break; 7472 7473 if (nfds == -1) 7474 { 7475 /* If the system call was interrupted, then go around the 7476 loop again. */ 7477 if (xerrno == EINTR) 7478 FD_ZERO (&waitchannels); 7479 else 7480 error ("select error: %s", emacs_strerror (xerrno)); 7481 } 7482#ifdef sun 7483 else if (nfds > 0 && (waitchannels & 1) && interrupt_input) 7484 /* System sometimes fails to deliver SIGIO. */ 7485 kill (getpid (), SIGIO); 7486#endif 7487#ifdef SIGIO 7488 if (read_kbd && interrupt_input && (waitchannels & 1)) 7489 kill (getpid (), SIGIO); 7490#endif 7491 7492 /* Check for keyboard input */ 7493 7494 if (read_kbd 7495 && detect_input_pending_run_timers (do_display)) 7496 { 7497 swallow_events (do_display); 7498 if (detect_input_pending_run_timers (do_display)) 7499 break; 7500 } 7501 7502 /* If there is unread keyboard input, also return. */ 7503 if (read_kbd 7504 && requeued_events_pending_p ()) 7505 break; 7506 7507 /* If wait_for_cell. check for keyboard input 7508 but don't run any timers. 7509 ??? (It seems wrong to me to check for keyboard 7510 input at all when wait_for_cell, but the code 7511 has been this way since July 1994. 7512 Try changing this after version 19.31.) */ 7513 if (! NILP (wait_for_cell) 7514 && detect_input_pending ()) 7515 { 7516 swallow_events (do_display); 7517 if (detect_input_pending ()) 7518 break; 7519 } 7520 7521 /* Exit now if the cell we're waiting for became non-nil. */ 7522 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 7523 break; 7524 } 7525 7526 start_polling (); 7527 7528 return 0; 7529} 7530 7531 7532/* Don't confuse make-docfile by having two doc strings for this function. 7533 make-docfile does not pay attention to #if, for good reason! */ 7534DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, 7535 0) 7536 (name) 7537 register Lisp_Object name; 7538{ 7539 return Qnil; 7540} 7541 7542 /* Don't confuse make-docfile by having two doc strings for this function. 7543 make-docfile does not pay attention to #if, for good reason! */ 7544DEFUN ("process-inherit-coding-system-flag", 7545 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, 7546 1, 1, 0, 7547 0) 7548 (process) 7549 register Lisp_Object process; 7550{ 7551 /* Ignore the argument and return the value of 7552 inherit-process-coding-system. */ 7553 return inherit_process_coding_system ? Qt : Qnil; 7554} 7555 7556/* Kill all processes associated with `buffer'. 7557 If `buffer' is nil, kill all processes. 7558 Since we have no subprocesses, this does nothing. */ 7559 7560void 7561kill_buffer_processes (buffer) 7562 Lisp_Object buffer; 7563{ 7564} 7565 7566void 7567init_process () 7568{ 7569} 7570 7571void 7572syms_of_process () 7573{ 7574 QCtype = intern (":type"); 7575 staticpro (&QCtype); 7576 7577 defsubr (&Sget_buffer_process); 7578 defsubr (&Sprocess_inherit_coding_system_flag); 7579} 7580 7581 7582#endif /* not subprocesses */ 7583 7584/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4 7585 (do not change this comment) */ 7586