X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fprocess-unix.c;h=424246f6f15bfb79cc7f177d68356e08e2a3ee5a;hp=a0b6b740690bf68029027870584a9d6abb2fc8d1;hb=ee38d21b330f5001b47a577cefb5ba7b82a3b7d3;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/src/process-unix.c b/src/process-unix.c index a0b6b74..424246f 100644 --- a/src/process-unix.c +++ b/src/process-unix.c @@ -1,4 +1,4 @@ -/* Asynchronous subprocess implemenation for UNIX +/* Asynchronous subprocess implementation for UNIX Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. @@ -28,6 +28,9 @@ Boston, MA 02111-1307, USA. */ Kirill M. Katsnelson , so please bash him and not the original author(s) */ +/* The IPv6 support is derived from the code for GNU Emacs-20.3 + written by Wolfgang S. Rupprecht */ + #include #if !defined (NO_SUBPROCESSES) @@ -37,11 +40,9 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "buffer.h" -#include "commands.h" #include "events.h" #include "frame.h" #include "hash.h" -#include "insdel.h" #include "lstream.h" #include "opaque.h" #include "process.h" @@ -60,9 +61,12 @@ Boston, MA 02111-1307, USA. */ #include "systty.h" #include "syswait.h" +#ifdef HPUX +#include /* See grantpt fixups for HPUX below. */ +#endif /* - * Implemenation-specific data. Pointed to by Lisp_Process->process_data + * Implementation-specific data. Pointed to by Lisp_Process->process_data */ struct unix_process_data @@ -82,12 +86,6 @@ struct unix_process_data #define UNIX_DATA(p) ((struct unix_process_data*)((p)->process_data)) -#ifdef HAVE_PTYS -/* The file name of the pty opened by allocate_pty. */ - -static char pty_name[24]; -#endif - /**********************************************************************/ @@ -126,7 +124,7 @@ close_descriptor_pair (int in, int out) to get rid of irrelevant descriptors. */ static int -close_process_descs_mapfun (CONST void* key, void* contents, void* arg) +close_process_descs_mapfun (const void* key, void* contents, void* arg) { Lisp_Object proc; CVOID_TO_LISP (proc, contents); @@ -151,17 +149,17 @@ close_process_descs (void) /* This function used to be visible on the Lisp level, but there is no real point in doing that. Here is the doc string: - "Connect to an existing file descriptor.\n\ -Returns a subprocess-object to represent the connection.\n\ -Input and output work as for subprocesses; `delete-process' closes it.\n\ -Args are NAME BUFFER INFD OUTFD.\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer (or buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer\n\ -INFD and OUTFD specify the file descriptors to use for input and\n\ + "Connect to an existing file descriptor. +Return a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER INFD OUTFD. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may also be nil, meaning that this process is not associated + with any buffer. +INFD and OUTFD specify the file descriptors to use for input and output, respectively." */ @@ -178,15 +176,16 @@ connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer, CHECK_INT (outfd); inch = XINT (infd); - if (get_process_from_usid (FD_TO_USID(inch))) - error ("There is already a process connected to fd %d", inch); + if (get_process_from_usid (FD_TO_USID (inch))) + invalid_operation ("There is already a process connected to fd", infd); if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); proc = make_process_internal (name); XPROCESS (proc)->pid = Fcons (infd, name); XPROCESS (proc)->buffer = buffer; - init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)XINT (outfd), 0); + init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)XINT (outfd), + 0); UNIX_DATA (XPROCESS (proc))->connected_via_filedesc_p = 1; event_stream_select_process (XPROCESS (proc)); @@ -195,16 +194,164 @@ connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer, } #ifdef HAVE_PTYS +static int allocate_pty_the_old_fashioned_way (void); + +/* The file name of the (slave) pty opened by allocate_pty(). */ +#ifndef MAX_PTYNAME_LEN +#define MAX_PTYNAME_LEN 64 +#endif +static char pty_name[MAX_PTYNAME_LEN]; /* Open an available pty, returning a file descriptor. Return -1 on failure. The file name of the terminal corresponding to the pty - is left in the variable pty_name. */ + is left in the variable `pty_name'. */ static int allocate_pty (void) { -#ifndef PTY_OPEN + /* Unix98 standardized grantpt, unlockpt, and ptsname, but not the + functions required to open a master pty in the first place :-( + + Modern Unix systems all seems to have convenience methods to open + a master pty fd in one function call, but there is little + agreement on how to do it. + + allocate_pty() tries all the different known easy ways of opening + a pty. In case of failure, we resort to the old BSD-style pty + grovelling code in allocate_pty_the_old_fashioned_way(). */ +#ifndef FORCE_ALLOCATE_PTY_THE_OLD_FASHIONED_WAY + int master_fd = -1; + const char *slave_name = NULL; + const char *clone = NULL; + static const char * const clones[] = /* Different pty master clone devices */ + { + "/dev/ptmx", /* Various systems */ + "/dev/ptm/clone", /* HPUX */ + "/dev/ptc", /* AIX */ + "/dev/ptmx_bsd" /* Tru64 */ + }; + +#ifdef HAVE_GETPT /* glibc */ + master_fd = getpt (); + if (master_fd >= 0) + goto have_master; +#endif /* HAVE_GETPT */ + + +#if defined(HAVE_OPENPTY) /* BSD, Tru64, glibc */ + { + int slave_fd = -1; + int rc; + EMACS_BLOCK_SIGNAL (SIGCHLD); + rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL); + EMACS_UNBLOCK_SIGNAL (SIGCHLD); + if (rc == 0) + { + slave_name = ttyname (slave_fd); + close (slave_fd); + goto have_slave_name; + } + else + { + if (master_fd >= 0) + close (master_fd); + if (slave_fd >= 0) + close (slave_fd); + } + } +#endif /* HAVE_OPENPTY */ + +#if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */ + master_fd = -1; + EMACS_BLOCK_SIGNAL (SIGCHLD); + slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0); + EMACS_UNBLOCK_SIGNAL (SIGCHLD); + if (master_fd >= 0 && slave_name != NULL) + goto have_slave_name; +#endif /* HAVE__GETPTY */ + + /* Master clone devices are available on most systems */ + { + int i; + for (i = 0; i < countof (clones); i++) + { + clone = clones[i]; + master_fd = open (clone, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); + if (master_fd >= 0) + goto have_master; + } + clone = NULL; + } + + goto lose; + + have_master: + +#if defined (HAVE_PTSNAME) + slave_name = ptsname (master_fd); + if (slave_name) + goto have_slave_name; +#endif + + /* AIX docs say to use ttyname, not ptsname, to get slave_name */ + if (clone + && !strcmp (clone, "/dev/ptc") + && (slave_name = ttyname (master_fd)) != NULL) + goto have_slave_name; + + goto lose; + + have_slave_name: + strncpy (pty_name, slave_name, sizeof (pty_name)); + pty_name[sizeof (pty_name) - 1] = '\0'; + setup_pty (master_fd); + + /* We jump through some hoops to frob the pty. + It's not obvious that checking the return code here is useful. */ + + /* "The grantpt() function will fail if it is unable to successfully + invoke the setuid root program. It may also fail if the + application has installed a signal handler to catch SIGCHLD + signals." */ +#if defined (HAVE_GRANTPT) || defined (HAVE_UNLOCKPT) + EMACS_BLOCK_SIGNAL (SIGCHLD); + +#if defined (HAVE_GRANTPT) + grantpt (master_fd); +#ifdef HPUX + /* grantpt() behavior on some versions of HP-UX differs from what's + specified in the man page: the group of the slave PTY is set to + the user's primary group, and we fix that. */ + { + struct group *tty_group = getgrnam ("tty"); + if (tty_group != NULL) + chown (pty_name, (uid_t) -1, tty_group->gr_gid); + } +#endif /* HPUX has broken grantpt() */ +#endif /* HAVE_GRANTPT */ + +#if defined (HAVE_UNLOCKPT) + unlockpt (master_fd); +#endif + + EMACS_UNBLOCK_SIGNAL (SIGCHLD); +#endif /* HAVE_GRANTPT || HAVE_UNLOCKPT */ + + return master_fd; + + lose: + if (master_fd >= 0) + close (master_fd); +#endif /* ndef FORCE_ALLOCATE_PTY_THE_OLD_FASHIONED_WAY */ + return allocate_pty_the_old_fashioned_way (); +} + +/* This function tries to allocate a pty by iterating through file + pairs with names like /dev/ptyp1 and /dev/ttyp1. */ +static int +allocate_pty_the_old_fashioned_way (void) +{ struct stat stb; /* Some systems name their pseudoterminals so that there are gaps in @@ -213,17 +360,20 @@ allocate_pty (void) three failures in a row before deciding that we've reached the end of the ptys. */ int failed_count = 0; -#endif - int i; int fd; + int i; int c; #ifdef PTY_ITERATION PTY_ITERATION #else +# ifndef FIRST_PTY_LETTER +# define FIRST_PTY_LETTER 'p' +# endif for (c = FIRST_PTY_LETTER; c <= 'z'; c++) for (i = 0; i < 16; i++) -#endif +#endif /* PTY_ITERATION */ + { #ifdef PTY_NAME_SPRINTF PTY_NAME_SPRINTF @@ -231,57 +381,30 @@ allocate_pty (void) sprintf (pty_name, "/dev/pty%c%x", c, i); #endif /* no PTY_NAME_SPRINTF */ -#ifdef PTY_OPEN - PTY_OPEN; -#else /* no PTY_OPEN */ -#ifdef IRIS - /* Unusual IRIS code */ - *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY | OPEN_BINARY, 0); - if (fd < 0) - return -1; - if (fstat (fd, &stb) < 0) - return -1; -#else /* not IRIS */ - if (stat (pty_name, &stb) < 0) + if (xemacs_stat (pty_name, &stb) < 0) { - failed_count++; - if (failed_count >= 3) + if (++failed_count >= 3) return -1; } else failed_count = 0; -#ifdef O_NONBLOCK fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); -#else - fd = open (pty_name, O_RDWR | O_NDELAY | OPEN_BINARY, 0); -#endif -#endif /* not IRIS */ -#endif /* no PTY_OPEN */ if (fd >= 0) { - /* check to make certain that both sides are available - this avoids a nasty yet stupid bug in rlogins */ #ifdef PTY_TTY_NAME_SPRINTF PTY_TTY_NAME_SPRINTF #else sprintf (pty_name, "/dev/tty%c%x", c, i); #endif /* no PTY_TTY_NAME_SPRINTF */ -#ifndef UNIPLUS - if (access (pty_name, 6) != 0) + if (access (pty_name, R_OK | W_OK) == 0) { - close (fd); -#if !defined(IRIS) && !defined(__sgi) - continue; -#else - return -1; -#endif /* IRIS */ + setup_pty (fd); + return fd; } -#endif /* not UNIPLUS */ - setup_pty (fd); - return fd; + close (fd); } - } + } /* iteration */ return -1; } #endif /* HAVE_PTYS */ @@ -314,6 +437,7 @@ create_bidirectional_pipe (int *inchannel, int *outchannel, #ifdef HAVE_SOCKETS +#if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)) static int get_internet_address (Lisp_Object host, struct sockaddr_in *address, Error_behavior errb) @@ -369,9 +493,10 @@ get_internet_address (Lisp_Object host, struct sockaddr_in *address, return 1; } +#endif /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ static void -set_socket_nonblocking_maybe (int fd, int port, CONST char* proto) +set_socket_nonblocking_maybe (int fd, int port, const char* proto) { #ifdef PROCESS_IO_BLOCKING Lisp_Object tail; @@ -390,7 +515,7 @@ set_socket_nonblocking_maybe (int fd, int port, CONST char* proto) else continue; } - else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port)) + else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port)) break; } @@ -409,7 +534,7 @@ set_socket_nonblocking_maybe (int fd, int port, CONST char* proto) the numeric status that was returned by `wait'. */ static void -update_status_from_wait_code (struct Lisp_Process *p, int *w_fmh) +update_status_from_wait_code (Lisp_Process *p, int *w_fmh) { /* C compiler lossage when attempting to pass w directly */ int w = *w_fmh; @@ -524,7 +649,7 @@ record_exited_processes (int block_sigchld) } /* For any processes that have changed status and are recorded - and such, update the corresponding struct Lisp_Process. + and such, update the corresponding Lisp_Process. We separate this from record_exited_processes() so that we never have to call this function from within a signal handler. We block SIGCHLD in case record_exited_processes() @@ -574,14 +699,14 @@ static int process_signal_char (int tty_fd, int signo) { /* If it's not a tty, pray that these default values work */ - if (!isatty(tty_fd)) { + if (! isatty (tty_fd)) { #define CNTL(ch) (037 & (ch)) switch (signo) { - case SIGINT: return CNTL('C'); - case SIGQUIT: return CNTL('\\'); + case SIGINT: return CNTL ('C'); + case SIGQUIT: return CNTL ('\\'); #ifdef SIGTSTP - case SIGTSTP: return CNTL('Z'); + case SIGTSTP: return CNTL ('Z'); #endif } } @@ -653,7 +778,7 @@ process_signal_char (int tty_fd, int signo) */ static void -unix_alloc_process_data (struct Lisp_Process *p) +unix_alloc_process_data (Lisp_Process *p) { p->process_data = xnew (struct unix_process_data); @@ -669,14 +794,13 @@ unix_alloc_process_data (struct Lisp_Process *p) */ static void -unix_mark_process_data (struct Lisp_Process *proc, - void (*markobj) (Lisp_Object)) +unix_mark_process_data (Lisp_Process *proc) { - ((markobj) (UNIX_DATA(proc)->tty_name)); + mark_object (UNIX_DATA(proc)->tty_name); } /* - * Initialize XEmacs process implemenation once + * Initialize XEmacs process implementation once */ #ifdef SIGCHLD @@ -694,56 +818,37 @@ unix_init_process (void) * Initialize any process local data. This is called when newly * created process is connected to real OS file handles. The * handles are generally represented by void* type, but are - * of type int (file descriptors) for UNIX + * of type int (file descriptors) for UNIX. */ static void -unix_init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) +unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags) { UNIX_DATA(p)->infd = (int)in; } /* - * Fork off a subprocess. P is a pointer to newly created subprocess + * Fork off a subprocess. P is a pointer to a newly created subprocess * object. If this function signals, the caller is responsible for * deleting (and finalizing) the process object. * - * The method must return PID of the new proces, a (positive??? ####) number + * The method must return PID of the new process, a (positive??? ####) number * which fits into Lisp_Int. No return value indicates an error, the method * must signal an error instead. */ static int -unix_create_process (struct Lisp_Process *p, +unix_create_process (Lisp_Process *p, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { - /* This function rewritten by ben@xemacs.org. */ - - int pid, inchannel, outchannel; + int pid; + int inchannel = -1; + int outchannel = -1; /* Use volatile to protect variables from being clobbered by longjmp. */ - volatile int forkin, forkout; + volatile int forkin = -1; + volatile int forkout = -1; volatile int pty_flag = 0; - char **env; - char **new_argv; - char *current_dir; - int i; - - env = environ; - - inchannel = outchannel = forkin = forkout = -1; - - /* Nothing below here GCs so our string pointers shouldn't move. */ - new_argv = alloca_array (char *, nargv + 2); - new_argv[0] = (char *) XSTRING_DATA (program); - for (i = 0; i < nargv; i++) - { - Lisp_Object tem = argv[i]; - CHECK_STRING (tem); - new_argv[i + 1] = (char *) XSTRING_DATA (tem); - } - new_argv[i + 1] = 0; - current_dir = (char *) XSTRING_DATA (cur_dir); #ifdef HAVE_PTYS if (!NILP (Vprocess_connection_type)) @@ -761,7 +866,7 @@ unix_create_process (struct Lisp_Process *p, better error checking. */ #if !defined(USG) /* On USG systems it does not work to open the pty's tty here - and then close and reopen it in the child. */ + and then close and reopen it in the child. */ #ifdef O_NOCTTY /* Don't let this terminal become our controlling terminal (in case we don't have one). */ @@ -787,6 +892,7 @@ unix_create_process (struct Lisp_Process *p, #endif set_descriptor_non_blocking (inchannel); + set_descriptor_non_blocking (outchannel); /* Record this as an active process, with its channels. As a result, child_setup will close Emacs's side of the pipes. */ @@ -796,20 +902,12 @@ unix_create_process (struct Lisp_Process *p, UNIX_DATA(p)->subtty = forkin; { -#if !defined(__CYGWIN32__) +#if !defined(CYGWIN) /* child_setup must clobber environ on systems with true vfork. Protect it from permanent change. */ char **save_environ = environ; #endif -#ifdef EMACS_BTL - /* when performance monitoring is on, turn it off before the vfork(), - as the child has no handler for the signal -- when back in the - parent process, turn it back on if it was really on when you "turned - it off" */ - int logging_on = cadillac_stop_logging (); /* #### rename me */ -#endif - pid = fork (); if (pid == 0) { @@ -817,17 +915,19 @@ unix_create_process (struct Lisp_Process *p, int xforkin = forkin; int xforkout = forkout; - if (!pty_flag) - EMACS_SEPARATE_PROCESS_GROUP (); -#ifdef HAVE_PTYS - else - { - /* Disconnect the current controlling terminal, pursuant to - making the pty be the controlling terminal of the process. - Also put us in our own process group. */ + /* Checking for quit in the child is bad because that will + cause I/O, and that, in turn, can confuse the X connection. */ + begin_dont_check_for_quit(); - disconnect_controlling_terminal (); + /* Disconnect the current controlling terminal, pursuant to + making the pty be the controlling terminal of the process. + Also put us in our own process group. */ + disconnect_controlling_terminal (); + +#ifdef HAVE_PTYS + if (pty_flag) + { /* Open the pty connection and make the pty's terminal our controlling terminal. @@ -880,9 +980,22 @@ unix_create_process (struct Lisp_Process *p, Must be done before using tc* functions on xforkin. This guarantees that isatty(xforkin) is true. */ -# ifdef SETUP_SLAVE_PTY - SETUP_SLAVE_PTY; -# endif /* SETUP_SLAVE_PTY */ +# if defined (HAVE_ISASTREAM) && defined (I_PUSH) + if (isastream (xforkin)) + { +# if defined (I_FIND) +# define stream_module_pushed(fd, module) (ioctl (fd, I_FIND, module) == 1) +# else +# define stream_module_pushed(fd, module) 0 +# endif + if (! stream_module_pushed (xforkin, "ptem")) + ioctl (xforkin, I_PUSH, "ptem"); + if (! stream_module_pushed (xforkin, "ldterm")) + ioctl (xforkin, I_PUSH, "ldterm"); + if (! stream_module_pushed (xforkin, "ttcompat")) + ioctl (xforkin, I_PUSH, "ttcompat"); + } +# endif /* HAVE_ISASTREAM */ # ifdef TIOCSCTTY /* We ignore the return value @@ -916,43 +1029,61 @@ unix_create_process (struct Lisp_Process *p, of our new controlling terminal. */ { - int piddly = EMACS_GET_PROCESS_GROUP (); + pid_t piddly = EMACS_GET_PROCESS_GROUP (); EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly); } -# ifdef AIX /* On AIX, we've disabled SIGHUP above once we start a child on a pty. Now reenable it in the child, so it - will die when we want it to. */ + will die when we want it to. + JV: This needs to be done ALWAYS as we might have inherited + a SIG_IGN handling from our parent (nohup) and we are in new + process group. + */ signal (SIGHUP, SIG_DFL); -# endif /* AIX */ } + + if (pty_flag) + /* Set up the terminal characteristics of the pty. */ + child_setup_tty (xforkout); + #endif /* HAVE_PTYS */ - signal (SIGINT, SIG_DFL); + signal (SIGINT, SIG_DFL); signal (SIGQUIT, SIG_DFL); - if (pty_flag) - { - /* Set up the terminal characteristics of the pty. */ - child_setup_tty (xforkout); - } + { + char *current_dir; + char **new_argv = alloca_array (char *, nargv + 2); + int i; - child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); - } -#ifdef EMACS_BTL - else if (logging_on) - cadillac_start_logging (); /* #### rename me */ -#endif + /* Nothing below here GCs so our string pointers shouldn't move. */ + new_argv[0] = (char *) XSTRING_DATA (program); + for (i = 0; i < nargv; i++) + { + CHECK_STRING (argv[i]); + new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]); + } + new_argv[i + 1] = 0; + + LISP_STRING_TO_EXTERNAL (cur_dir, current_dir, Qfile_name); -#if !defined(__CYGWIN32__) + child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); + } + + } /**** End of child code ****/ + + /**** Back in parent process ****/ +#if !defined(CYGWIN) environ = save_environ; #endif } if (pid < 0) { + int save_errno = errno; close_descriptor_pair (forkin, forkout); + errno = save_errno; report_file_error ("Doing fork", Qnil); } @@ -984,32 +1115,27 @@ unix_create_process (struct Lisp_Process *p, io_failure: { - int temp = errno; + int save_errno = errno; close_descriptor_pair (forkin, forkout); close_descriptor_pair (inchannel, outchannel); - errno = temp; + errno = save_errno; report_file_error ("Opening pty or pipe", Qnil); + return 0; /* not reached */ } - - RETURN_NOT_REACHED (0); } -/* - * Return nonzero if this process is a ToolTalk connection. - */ +/* Return nonzero if this process is a ToolTalk connection. */ static int -unix_tooltalk_connection_p (struct Lisp_Process *p) +unix_tooltalk_connection_p (Lisp_Process *p) { return UNIX_DATA(p)->connected_via_filedesc_p; } -/* - * This is called to set process' virtual terminal size - */ +/* This is called to set process' virtual terminal size */ static int -unix_set_window_size (struct Lisp_Process* p, int cols, int rows) +unix_set_window_size (Lisp_Process* p, int cols, int rows) { return set_window_size (UNIX_DATA(p)->infd, cols, rows); } @@ -1024,7 +1150,7 @@ unix_set_window_size (struct Lisp_Process* p, int cols, int rows) #ifdef HAVE_WAITPID static void -unix_update_status_if_terminated (struct Lisp_Process* p) +unix_update_status_if_terminated (Lisp_Process* p) { int w; #ifdef SIGCHLD @@ -1050,7 +1176,7 @@ static void unix_reap_exited_processes (void) { int i; - struct Lisp_Process *p; + Lisp_Process *p; #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR record_exited_processes (1); @@ -1130,7 +1256,7 @@ unix_reap_exited_processes (void) #endif /* SIGCHLD */ /* - * Stuff the entire contents of LSTREAM to the process ouptut pipe + * Stuff the entire contents of LSTREAM to the process output pipe */ static JMP_BUF send_process_frame; @@ -1149,7 +1275,15 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream) /* Use volatile to protect variables from being clobbered by longjmp. */ SIGTYPE (*volatile old_sigpipe) (int) = 0; volatile Lisp_Object vol_proc = proc; - struct Lisp_Process *volatile p = XPROCESS (proc); + Lisp_Process *volatile p = XPROCESS (proc); + + /* #### JV: layering violation? + + This function knows too much about the relation between the encoding + stream (DATA_OUTSTREAM) and the actual output stream p->output_stream. + + If encoding streams properly forwarded all calls, we could simply + use DATA_OUTSTREAM everywhere. */ if (!SETJMP (send_process_frame)) { @@ -1161,11 +1295,11 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream) while (1) { - int writeret; + Lstream_data_count writeret; chunklen = Lstream_read (lstream, chunkbuf, 512); if (chunklen <= 0) - break; /* perhaps should abort() if < 0? + break; /* perhaps should ABORT() if < 0? This should never happen. */ old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); @@ -1178,14 +1312,16 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream) if (writeret < 0) /* This is a real error. Blocking errors are handled specially inside of the filedesc stream. */ - report_file_error ("writing to process", - list1 (vol_proc)); + report_file_error ("writing to process", list1 (proc)); while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream))) { /* Buffer is full. Wait, accepting input; that may allow the program to finish doing output and read more. */ Faccept_process_output (Qnil, make_int (1), Qnil); + /* It could have *really* finished, deleting the process */ + if (NILP(p->pipe_outstream)) + return; old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); Lstream_flush (XLSTREAM (p->pipe_outstream)); @@ -1196,14 +1332,20 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream) else { /* We got here from a longjmp() from the SIGPIPE handler */ signal (SIGPIPE, old_sigpipe); + /* Close the file lstream so we don't attempt to write to it further */ + /* #### There is controversy over whether this might cause fd leakage */ + /* my tests say no. -slb */ + XLSTREAM (p->pipe_outstream)->flags &= ~LSTREAM_FL_IS_OPEN; +#ifdef FILE_CODING + XLSTREAM (p->coding_outstream)->flags &= ~LSTREAM_FL_IS_OPEN; +#endif p->status_symbol = Qexit; p->exit_code = 256; /* #### SIGPIPE ??? */ p->core_dumped = 0; p->tick++; process_tick++; - deactivate_process (vol_proc); - error ("SIGPIPE raised on process %s; closed it", - XSTRING_DATA (p->name)); + deactivate_process (*((Lisp_Object *) (&vol_proc))); + invalid_operation ("SIGPIPE raised on process; closed it", p->name); } old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); @@ -1232,7 +1374,7 @@ unix_process_send_eof (Lisp_Object proc) Bufbyte eof_char = get_eof_char (XPROCESS (proc)); send_process (proc, Qnil, &eof_char, 0, 1); #else - send_process (proc, Qnil, (CONST Bufbyte *) "\004", 0, 1); + send_process (proc, Qnil, (const Bufbyte *) "\004", 0, 1); #endif return 1; } @@ -1248,11 +1390,11 @@ unix_process_send_eof (Lisp_Object proc) * In the lack of this method, only event_stream_delete_stream_pair * is called on both I/O streams of the process. * - * The UNIX version quards this by ignoring possible SIGPIPE. + * The UNIX version guards this by ignoring possible SIGPIPE. */ static USID -unix_deactivate_process (struct Lisp_Process *p) +unix_deactivate_process (Lisp_Process *p) { SIGTYPE (*old_sigpipe) (int) = 0; USID usid; @@ -1270,7 +1412,17 @@ unix_deactivate_process (struct Lisp_Process *p) return usid; } -/* send a signal number SIGNO to PROCESS. +/* If the subtty field of the process data is not filled in, do so now. */ +static void +try_to_initialize_subtty (struct unix_process_data *upd) +{ + if (upd->pty_flag + && (upd->subtty == -1 || ! isatty (upd->subtty)) + && STRINGP (upd->tty_name)) + upd->subtty = open ((char *) XSTRING_DATA (upd->tty_name), O_RDWR, 0); +} + +/* Send signal number SIGNO to PROCESS. CURRENT_GROUP means send to the process group that currently owns the terminal being used to communicate with PROCESS. This is used for various commands in shell mode. @@ -1279,70 +1431,18 @@ unix_deactivate_process (struct Lisp_Process *p) If we can, we try to signal PROCESS by sending control characters down the pty. This allows us to signal inferiors who have changed - their uid, for which killpg would return an EPERM error. + their uid, for which killpg would return an EPERM error, + or processes running on other machines via remote login. - The method signals an error if the given SIGNO is not valid -*/ + The method signals an error if the given SIGNO is not valid. */ static void unix_kill_child_process (Lisp_Object proc, int signo, int current_group, int nomsg) { - int gid; - int no_pgrp = 0; - int kill_retval; - struct Lisp_Process *p = XPROCESS (proc); - - if (!UNIX_DATA(p)->pty_flag) - current_group = 0; - - /* If we are using pgrps, get a pgrp number and make it negative. */ - if (current_group) - { -#ifdef SIGNALS_VIA_CHARACTERS - /* If possible, send signals to the entire pgrp - by sending an input character to it. */ - { - char sigchar = process_signal_char(UNIX_DATA(p)->subtty, signo); - if (sigchar) { - send_process (proc, Qnil, (Bufbyte *) &sigchar, 0, 1); - return; - } - } -#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */ - -#ifdef TIOCGPGRP - /* Get the pgrp using the tty itself, if we have that. - Otherwise, use the pty to get the pgrp. - On pfa systems, saka@pfu.fujitsu.co.JP writes: - "TIOCGPGRP symbol defined in sys/ioctl.h at E50. - But, TIOCGPGRP does not work on E50 ;-P works fine on E60" - His patch indicates that if TIOCGPGRP returns an error, then - we should just assume that p->pid is also the process group id. */ - { - int err; - - err = ioctl ( (UNIX_DATA(p)->subtty != -1 - ? UNIX_DATA(p)->subtty - : UNIX_DATA(p)->infd), TIOCGPGRP, &gid); - -#ifdef pfa - if (err == -1) - gid = - XINT (p->pid); -#endif /* ! defined (pfa) */ - } - if (gid == -1) - no_pgrp = 1; - else - gid = - gid; -#else /* ! defined (TIOCGPGRP ) */ - /* Can't select pgrps on this system, so we know that - the child itself heads the pgrp. */ - gid = - XINT (p->pid); -#endif /* ! defined (TIOCGPGRP ) */ - } - else - gid = - XINT (p->pid); + pid_t pgid = -1; + Lisp_Process *p = XPROCESS (proc); + struct unix_process_data *d = UNIX_DATA (p); switch (signo) { @@ -1359,46 +1459,113 @@ unix_kill_child_process (Lisp_Object proc, int signo, case SIGINT: case SIGQUIT: case SIGKILL: - flush_pending_output (UNIX_DATA(p)->infd); + flush_pending_output (d->infd); break; } - /* If we don't have process groups, send the signal to the immediate - subprocess. That isn't really right, but it's better than any - obvious alternative. */ - if (no_pgrp) - { - kill_retval = kill (XINT (p->pid), signo) ? errno : 0; - } - else + if (! d->pty_flag) + current_group = 0; + + /* If current_group is true, we want to send a signal to the + foreground process group of the terminal our child process is + running on. You would think that would be easy. + + The BSD people invented the TIOCPGRP ioctl to get the foreground + process group of a tty. That, combined with killpg, gives us + what we want. + + However, the POSIX standards people, in their infinite wisdom, + have seen fit to only allow this for processes which have the + terminal as controlling terminal, which doesn't apply to us. + + Sooo..., we have to do something non-standard. The ioctls + TIOCSIGNAL, TIOCSIG, and TIOCSIGSEND send the signal directly on + many systems. POSIX tcgetpgrp(), since it is *documented* as not + doing what we want, is actually less likely to work than the BSD + ioctl TIOCGPGRP it is supposed to obsolete. Sometimes we have to + use TIOCGPGRP on the master end, sometimes the slave end + (probably an AIX bug). So we better get a fd for the slave if we + haven't got it yet. + + Anal operating systems like SGI Irix and Compaq Tru64 adhere + strictly to the letter of the law, so our hack doesn't work. + The following fragment from an Irix header file is suggestive: + + #ifdef __notdef__ + // this is not currently supported + #define TIOCSIGNAL (tIOC|31) // pty: send signal to slave + #endif + + On those systems where none of our tricks work, we just fall back + to the non-current_group behavior and kill the process group of + the child. + */ + if (current_group) { - /* gid may be a pid, or minus a pgrp's number */ -#if defined (TIOCSIGNAL) || defined (TIOCSIGSEND) - if (current_group) + try_to_initialize_subtty (d); + +#ifdef SIGNALS_VIA_CHARACTERS + /* If possible, send signals to the entire pgrp + by sending an input character to it. */ + { + char sigchar = process_signal_char (d->subtty, signo); + if (sigchar) + { + send_process (proc, Qnil, (Bufbyte *) &sigchar, 0, 1); + return; + } + } +#endif /* SIGNALS_VIA_CHARACTERS */ + +#ifdef TIOCGPGRP + if (pgid == -1) + ioctl (d->infd, TIOCGPGRP, &pgid); /* BSD */ + if (pgid == -1 && d->subtty != -1) + ioctl (d->subtty, TIOCGPGRP, &pgid); /* Only this works on AIX! */ +#endif /* TIOCGPGRP */ + + if (pgid == -1) { -#ifdef TIOCSIGNAL - kill_retval = ioctl (UNIX_DATA(p)->infd, TIOCSIGNAL, signo); -#else /* ! defined (TIOCSIGNAL) */ - kill_retval = ioctl (UNIX_DATA(p)->infd, TIOCSIGSEND, signo); -#endif /* ! defined (TIOCSIGNAL) */ + /* Many systems provide an ioctl to send a signal directly */ +#ifdef TIOCSIGNAL /* Solaris, HP-UX */ + if (ioctl (d->infd, TIOCSIGNAL, signo) != -1) + return; +#endif /* TIOCSIGNAL */ + +#ifdef TIOCSIG /* BSD */ + if (ioctl (d->infd, TIOCSIG, signo) != -1) + return; +#endif /* TIOCSIG */ } - else - kill_retval = kill (- XINT (p->pid), signo) ? errno : 0; -#else /* ! (defined (TIOCSIGNAL) || defined (TIOCSIGSEND)) */ - kill_retval = EMACS_KILLPG (-gid, signo) ? errno : 0; -#endif /* ! (defined (TIOCSIGNAL) || defined (TIOCSIGSEND)) */ + } /* current_group */ + + if (pgid == -1) + /* Either current_group is 0, or we failed to get the foreground + process group using the trickery above. So we fall back to + sending the signal to the process group of our child process. + Since this is often a shell that ignores signals like SIGINT, + the shell's subprocess is killed, which is the desired effect. + The process group of p->pid is always p->pid, since it was + created as a process group leader. */ + pgid = XINT (p->pid); + + /* Finally send the signal. */ + if (EMACS_KILLPG (pgid, signo) == -1) + { + /* It's not an error if our victim is already dead. + And we can't rely on the result of killing a zombie, since + XPG 4.2 requires that killing a zombie fail with ESRCH, + while FIPS 151-2 requires that it succeeds! */ +#ifdef ESRCH + if (errno != ESRCH) +#endif + error ("kill (%ld, %ld) failed: %s", + (long) pgid, (long) signo, strerror (errno)); } - - if (kill_retval < 0 && errno == EINVAL) - error ("Signal number %d is invalid for this system", signo); } -/* - * Kill any process in the system given its PID. - * - * Returns zero if a signal successfully sent, or - * negative number upon failure - */ +/* Send signal SIGCODE to any process in the system given its PID. + Return zero if successful, a negative number upon failure. */ static int unix_kill_process_by_pid (int pid, int sigcode) @@ -1406,26 +1573,60 @@ unix_kill_process_by_pid (int pid, int sigcode) return kill (pid, sigcode); } -/* - * Return TTY name used to communicate with subprocess - */ +/* Return TTY name used to communicate with subprocess. */ static Lisp_Object -unix_get_tty_name (struct Lisp_Process *p) +unix_get_tty_name (Lisp_Process *p) { return UNIX_DATA (p)->tty_name; } -/* - * Canonicalize host name HOST, and return its canonical form - * - * The default implemenation just takes HOST for a canonical name. - */ +/* Canonicalize host name HOST, and return its canonical form. + The default implementation just takes HOST for a canonical name. */ #ifdef HAVE_SOCKETS static Lisp_Object unix_canonicalize_host_name (Lisp_Object host) { +#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) + struct addrinfo hints, *res; + static char addrbuf[NI_MAXHOST]; + Lisp_Object canonname; + int retval; + char *ext_host; + + xzero (hints); + hints.ai_flags = AI_CANONNAME; +#ifdef IPV6_CANONICALIZE + hints.ai_family = AF_UNSPEC; +#else + hints.ai_family = PF_INET; +#endif + hints.ai_socktype = SOCK_STREAM; + hints.ai_protocol = 0; + LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative); + retval = getaddrinfo (ext_host, NULL, &hints, &res); + if (retval != 0) + { + char *gai_error; + + EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative); + maybe_error (Qprocess, ERROR_ME_NOT, + "%s \"%s\"", gai_error, XSTRING_DATA (host)); + canonname = host; + } + else + { + int gni = getnameinfo (res->ai_addr, res->ai_addrlen, + addrbuf, sizeof(addrbuf), + NULL, 0, NI_NUMERICHOST); + canonname = gni ? host : build_ext_string (addrbuf, Qnative); + + freeaddrinfo (res); + } + + return canonname; +#else /* ! HAVE_GETADDRINFO */ struct sockaddr_in address; if (!get_internet_address (host, &address, ERROR_ME_NOT)) @@ -1436,114 +1637,285 @@ unix_canonicalize_host_name (Lisp_Object host) else /* #### any clue what to do here? */ return host; +#endif /* ! HAVE_GETADDRINFO */ } -/* open a TCP network connection to a given HOST/SERVICE. Treated - exactly like a normal process when reading and writing. Only - differences are in status display and process deletion. A network - connection has no PID; you cannot signal it. All you can do is - deactivate and close it via delete-process */ +/* Open a TCP network connection to a given HOST/SERVICE. + Treated exactly like a normal process when reading and writing. + Only differences are in status display and process deletion. + A network connection has no PID; you cannot signal it. All you can + do is deactivate and close it via delete-process. */ static void unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, - Lisp_Object family, void** vinfd, void** voutfd) + Lisp_Object protocol, void** vinfd, void** voutfd) { - struct sockaddr_in address; - int s, inch, outch; + int inch; + int outch; + volatile int s; volatile int port; volatile int retry = 0; int retval; CHECK_STRING (host); - if (!EQ (family, Qtcpip)) - error ("Unsupported protocol family \"%s\"", - string_data (symbol_name (XSYMBOL (family)))); + if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp)) + invalid_argument ("Unsupported protocol", protocol); - if (INTP (service)) - port = htons ((unsigned short) XINT (service)); - else - { - struct servent *svc_info; - CHECK_STRING (service); - svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); - if (svc_info == 0) - error ("Unknown service \"%s\"", XSTRING_DATA (service)); - port = svc_info->s_port; - } + { +#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) + struct addrinfo hints, *res; + struct addrinfo * volatile lres; + char *portstring; + volatile int xerrno = 0; + volatile int failed_connect = 0; + char *ext_host; + /* + * Caution: service can either be a string or int. + * Convert to a C string for later use by getaddrinfo. + */ + if (INTP (service)) + { + char portbuf[128]; + snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service)); + portstring = portbuf; + port = htons ((unsigned short) XINT (service)); + } + else + { + CHECK_STRING (service); + LISP_STRING_TO_EXTERNAL (service, portstring, Qnative); + port = 0; + } - get_internet_address (host, &address, ERROR_ME); - address.sin_port = port; + xzero (hints); + hints.ai_flags = 0; + hints.ai_family = AF_UNSPEC; + if (EQ (protocol, Qtcp)) + hints.ai_socktype = SOCK_STREAM; + else /* EQ (protocol, Qudp) */ + hints.ai_socktype = SOCK_DGRAM; + hints.ai_protocol = 0; + LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative); + retval = getaddrinfo (ext_host, portstring, &hints, &res); + if (retval != 0) + { + char *gai_error; - s = socket (address.sin_family, SOCK_STREAM, 0); - if (s < 0) - report_file_error ("error creating socket", list1 (name)); + EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative); + error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error); + } - /* Turn off interrupts here -- see comments below. There used to - be code which called bind_polling_period() to slow the polling - period down rather than turn it off, but that seems rather - bogus to me. Best thing here is to use a non-blocking connect - or something, to check for QUIT. */ + /* address loop */ + for (lres = res; lres ; lres = lres->ai_next) + { + if (EQ (protocol, Qtcp)) + s = socket (lres->ai_family, SOCK_STREAM, 0); + else /* EQ (protocol, Qudp) */ + s = socket (lres->ai_family, SOCK_DGRAM, 0); - /* Comments that are not quite valid: */ + if (s < 0) + continue; - /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) - when connect is interrupted. So let's not let it get interrupted. - Note we do not turn off polling, because polling is only used - when not interrupt_input, and thus not normally used on the systems - which have this bug. On systems which use polling, there's no way - to quit if polling is turned off. */ + /* Turn off interrupts here -- see comments below. There used to + be code which called bind_polling_period() to slow the polling + period down rather than turn it off, but that seems rather + bogus to me. Best thing here is to use a non-blocking connect + or something, to check for QUIT. */ - /* Slow down polling. Some kernels have a bug which causes retrying - connect to fail after a connect. */ + /* Comments that are not quite valid: */ - slow_down_interrupts (); + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ - loop: + /* Slow down polling. Some kernels have a bug which causes retrying + connect to fail after a connect. */ - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); - } + slow_down_interrupts (); - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - retval = connect (s, (struct sockaddr *) &address, sizeof (address)); - can_break_system_calls = 0; - if (retval == -1 && errno != EISCONN) - { - int xerrno = errno; - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; + loop: + + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { + speed_up_interrupts (); + REALLY_QUIT; + /* In case something really weird happens ... */ + slow_down_interrupts (); + } + + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + retval = connect (s, lres->ai_addr, lres->ai_addrlen); + can_break_system_calls = 0; + if (retval == -1) + { + xerrno = errno; + if (errno != EISCONN) + { + if (errno == EINTR) + goto loop; + if (errno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. + `sleep-for' allowed for quitting this loop with interrupts + slowed down so it can't be used here. Async timers should + already be disabled at this point so we can use `sleep'. */ + sleep (1); + retry++; + goto loop; + } + } + + failed_connect = 1; + close (s); + s = -1; + + speed_up_interrupts (); + + continue; + } + + if (port == 0) + { + int gni; + char servbuf[NI_MAXSERV]; + + if (EQ (protocol, Qtcp)) + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV); + else /* EQ (protocol, Qudp) */ + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV | NI_DGRAM); + + if (gni == 0) + port = strtol (servbuf, NULL, 10); + } + + break; + } /* address loop */ + + speed_up_interrupts (); + + freeaddrinfo (res); + if (s < 0) + { + errno = xerrno; + + if (failed_connect) + report_file_error ("connection failed", list2 (host, name)); + else + report_file_error ("error creating socket", list1 (name)); + } +#else /* ! HAVE_GETADDRINFO */ + struct sockaddr_in address; + + if (INTP (service)) + port = htons ((unsigned short) XINT (service)); + else + { + struct servent *svc_info; + CHECK_STRING (service); + + if (EQ (protocol, Qtcp)) + svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); + else /* EQ (protocol, Qudp) */ + svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp"); + + if (svc_info == 0) + invalid_argument ("Unknown service", service); + port = svc_info->s_port; + } + + get_internet_address (host, &address, ERROR_ME); + address.sin_port = port; + + if (EQ (protocol, Qtcp)) + s = socket (address.sin_family, SOCK_STREAM, 0); + else /* EQ (protocol, Qudp) */ + s = socket (address.sin_family, SOCK_DGRAM, 0); + + if (s < 0) + report_file_error ("error creating socket", list1 (name)); + + /* Turn off interrupts here -- see comments below. There used to + be code which called bind_polling_period() to slow the polling + period down rather than turn it off, but that seems rather + bogus to me. Best thing here is to use a non-blocking connect + or something, to check for QUIT. */ + + /* Comments that are not quite valid: */ + + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ + + /* Slow down polling. Some kernels have a bug which causes retrying + connect to fail after a connect. */ + + slow_down_interrupts (); + + loop: + + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { + speed_up_interrupts (); + REALLY_QUIT; + /* In case something really weird happens ... */ + slow_down_interrupts (); + } + + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + retval = connect (s, (struct sockaddr *) &address, sizeof (address)); + can_break_system_calls = 0; + if (retval == -1 && errno != EISCONN) + { + int xerrno = errno; + if (errno == EINTR) goto loop; - } + if (errno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. + `sleep-for' allowed for quitting this loop with interrupts + slowed down so it can't be used here. Async timers should + already be disabled at this point so we can use `sleep'. */ + sleep (1); + retry++; + goto loop; + } - close (s); + close (s); - speed_up_interrupts (); + speed_up_interrupts (); - errno = xerrno; - report_file_error ("connection failed", list2 (host, name)); - } + errno = xerrno; + report_file_error ("connection failed", list2 (host, name)); + } - speed_up_interrupts (); + speed_up_interrupts (); +#endif /* ! HAVE_GETADDRINFO */ + } inch = s; outch = dup (s); @@ -1562,14 +1934,14 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic #ifdef HAVE_MULTICAST -/* Didier Verna Nov. 28 1997. +/* Didier Verna Nov. 28 1997. This function is similar to open-network-stream-internal, but provides a mean to open an UDP multicast connection instead of a TCP one. Like in the TCP case, the multicast connection will be seen as a sub-process, Some notes: - - Normaly, we should use sendto and recvfrom with non connected + - Normally, we should use sendto and recvfrom with non connected sockets. The current code doesn't allow us to do this. In the future, it would be a good idea to extend the process data structure in order to deal properly with the different types network connections. @@ -1581,8 +1953,9 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic */ static void -unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, - Lisp_Object ttl, void** vinfd, void** voutfd) +unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, + Lisp_Object port, Lisp_Object ttl, void** vinfd, + void** voutfd) { struct ip_mreq imr; struct sockaddr_in sa; @@ -1603,7 +1976,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, thettl = (unsigned char) XINT (ttl); if ((udp = getprotobyname ("udp")) == NULL) - error ("No info available for UDP protocol"); + type_error (Qinvalid_operation, "No info available for UDP protocol"); /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */ if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) @@ -1618,7 +1991,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, memset (&sa, 0, sizeof(sa)); sa.sin_family = AF_INET; sa.sin_port = theport; - sa.sin_addr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); + sa.sin_addr.s_addr = inet_addr ((char *) XSTRING_DATA (dest)); /* Socket configuration for reading ------------------------ */ @@ -1638,10 +2011,10 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, } /* join multicast group */ - imr.imr_multiaddr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); + imr.imr_multiaddr.s_addr = inet_addr ((char *) XSTRING_DATA (dest)); imr.imr_interface.s_addr = htonl (INADDR_ANY); if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, - (char *) &imr, sizeof (struct ip_mreq)) < 0) + &imr, sizeof (struct ip_mreq)) < 0) { close (ws); close (rs); @@ -1650,7 +2023,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, /* Socket configuration for writing ----------------------- */ - /* Normaly, there's no 'connect' in multicast, since we use preferentialy + /* Normally, there's no 'connect' in multicast, since we prefer to use 'sendto' and 'recvfrom'. However, in order to handle this connection in the process-like way it is done for TCP, we must be able to use 'write' instead of 'sendto'. Consequently, we 'connect' this socket. */ @@ -1707,7 +2080,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port, /* scope */ if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, - (char *) &thettl, sizeof (thettl)) < 0) + &thettl, sizeof (thettl)) < 0) { close (rs); close (ws);