-/* 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"
/*
- * Implemenation-specific data. Pointed to by Lisp_Process->process_data
+ * Implementation-specific data. Pointed to by Lisp_Process->process_data
*/
struct unix_process_data
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);
end of the ptys. */
int failed_count = 0;
#endif
- int i;
int fd;
+#ifndef HAVE_GETPT
+ int i;
int c;
+#endif
#ifdef PTY_ITERATION
PTY_ITERATION
#else /* no PTY_OPEN */
#ifdef IRIS
/* Unusual IRIS code */
- *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY | OPEN_BINARY, 0);
+ *ptyv = open ("/dev/ptc", O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
if (fd < 0)
return -1;
if (fstat (fd, &stb) < 0)
}
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 */
#else
sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif /* no PTY_TTY_NAME_SPRINTF */
-#ifndef UNIPLUS
+#if !defined(UNIPLUS) && !defined(HAVE_GETPT)
if (access (pty_name, 6) != 0)
{
close (fd);
#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()
*/
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
*/
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))
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). */
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)
{
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;
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, cur_dir,
+ C_STRING_ALLOCA, current_dir,
+ Qfile_name);
+ child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
+ }
+
+ } /**** End of child code ****/
+
+ /**** Back in parent process ****/
#if !defined(__CYGWIN32__)
environ = save_environ;
#endif
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 encodingstream
+ (DATA_OUTSTREAM) and te 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))
{
/* use a reasonable-sized buffer (somewhere around the size of the
while (1)
{
- int writeret;
+ ssize_t writeret;
chunklen = Lstream_read (lstream, chunkbuf, 512);
if (chunklen <= 0)
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));
p->core_dumped = 0;
p->tick++;
process_tick++;
- deactivate_process (vol_proc);
+ deactivate_process (*((Lisp_Object *) (&vol_proc)));
error ("SIGPIPE raised on process %s; closed it",
XSTRING_DATA (p->name));
}
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;
int gid;
int no_pgrp = 0;
int kill_retval;
- struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Process *p = XPROCESS (proc);
if (!UNIX_DATA(p)->pty_flag)
current_group = 0;
*/
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.
+ * 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;
+ hints.ai_family = AF_UNSPEC;
+ hints.ai_socktype = SOCK_STREAM;
+ hints.ai_protocol = 0;
+ TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative);
+ retval = getaddrinfo (ext_host, NULL, &hints, &res);
+ if (retval != 0)
+ {
+ char *gai_error;
+
+ TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
+ C_STRING_ALLOCA, 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
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))
+ error ("Unsupported protocol \"%s\"",
+ string_data (symbol_name (XSYMBOL (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);
+ TO_EXTERNAL_FORMAT (LISP_STRING, service,
+ C_STRING_ALLOCA, 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;
+ TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, 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));
+ TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
+ C_STRING_ALLOCA, 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);
+
+ 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)
+ error ("Unknown service \"%s\"", XSTRING_DATA (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.
/* 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. */
projects / chise / xemacs-chise.git.1 / blobdiff