-/* 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.
Kirill M. Katsnelson <kkm@kis.ru>, 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 <config.h>
#if !defined (NO_SUBPROCESSES)
#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"
#include "systty.h"
#include "syswait.h"
+#ifdef HPUX
+#include <grp.h> /* 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
#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
-
\f
/**********************************************************************/
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);
/* 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."
*/
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));
}
#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
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
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 */
#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)
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;
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;
}
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;
}
/* 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()
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
}
}
*/
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);
*/
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
* 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);
- GET_C_STRING_FILENAME_DATA_ALLOCA (program, new_argv[0]);
- 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;
- GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir);
#ifdef HAVE_PTYS
if (!NILP (Vprocess_connection_type))
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). */
#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. */
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)
{
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.
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
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);
}
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.
+ process group.
*/
signal (SIGHUP, SIG_DFL);
}
+
+ 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);
}
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);
}
#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
unix_reap_exited_processes (void)
{
int i;
- struct Lisp_Process *p;
+ Lisp_Process *p;
#ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
record_exited_processes (1);
#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;
/* 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))
{
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);
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));
/* #### 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);
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;
}
* 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;
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.
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)
{
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)
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))
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);
#ifdef HAVE_MULTICAST
-/* Didier Verna <verna@inf.enst.fr> Nov. 28 1997.
+/* Didier Verna <didier@xemacs.org> 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.
*/
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;
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)
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 ------------------------ */
}
/* 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);
/* 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. */
/* scope */
if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
- (char *) &thettl, sizeof (thettl)) < 0)
+ &thettl, sizeof (thettl)) < 0)
{
close (rs);
close (ws);
projects / chise / xemacs-chise.git.1 / blobdiff