xemacs-beta: src/process-unix.c comparison

comparison src/process-unix.c @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28

author	cvs
date	Mon, 13 Aug 2007 11:33:38 +0200
parents	3ecd8885ac67
children	abe6d1db359e

comparison

equal deleted inserted replaced

-:357dd071b03c
+:8de8e3f6228a
 `open-network-stream-internal' and `open-multicast-group-internal'. */
 /* This file has been split into process.c and process-unix.c by
 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)
 }
 #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)
 {
 struct hostent *host_info_ptr = NULL;
 * (IN_ADDR *) &address->sin_addr = numeric_addr;
 }
 return 1;
 }
+#endif /*  !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */
 static void
 set_socket_nonblocking_maybe (int fd, int port, CONST char* proto)
 {
 #ifdef PROCESS_IO_BLOCKING
 /* Compute the Lisp form of the process status from
 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;
 if (WIFSTOPPED (w))
 if (block_sigchld)
 EMACS_UNBLOCK_SIGNAL (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()
 is called from a signal handler. */
 /*
 * Allocate and initialize Lisp_Process->process_data
 */
 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);
 UNIX_DATA(p)->connected_via_filedesc_p = 0;
 UNIX_DATA(p)->infd   = -1;
 /*
 * Mark any Lisp objects in Lisp_Process->process_data
 */
 static void
-unix_mark_process_data (struct Lisp_Process *proc)
+unix_mark_process_data (Lisp_Process *proc)
 {
 mark_object (UNIX_DATA(proc)->tty_name);
 }
 /*
 * handles are generally represented by void* type, but are
 * 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;
 }
 /*
 * 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. */
 	      CHECK_STRING (argv[i]);
 	      new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]);
 	    }
 	  new_argv[i + 1] = 0;
-	  GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir);
+	  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 ****/
 }
 /* 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 */
 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);
 }
 /*
 * The method is called only for real child processes.
 */
 #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
 EMACS_BLOCK_SIGNAL (SIGCHLD);
 #endif
 #ifdef SIGCHLD
 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);
 #endif
 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);
 if (!SETJMP (send_process_frame))
 {
 /* use a reasonable-sized buffer (somewhere around the size of the
 	 stream buffer) so as to avoid inundating the stream with blocked
 *
 * 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;
 if (UNIX_DATA(p)->infd >= 0)
 			 int current_group, int nomsg)
 {
 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;
 /* If we are using pgrps, get a pgrp number and make it negative.  */
 /*
 * 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;
 }
 /*
 #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))
 return host;
 if (address.sin_family == AF_INET)
 return build_string (inet_ntoa (address.sin_addr));
 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
 static void
 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
 			  Lisp_Object protocol, void** vinfd, void** voutfd)
 {
-struct sockaddr_in address;
 int inch;
 int outch;
 volatile int s;
 volatile int port;
 volatile int retry = 0;
 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));
+#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
-else
+struct addrinfo hints, *res;
-{
+struct addrinfo * volatile lres;
-struct servent *svc_info;
+char *portstring;
-CHECK_STRING (service);
+volatile int xerrno = 0;
+volatile int failed_connect = 0;
-if (EQ (protocol, Qtcp))
+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;
+}
+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;
+	TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
+			    C_STRING_ALLOCA, gai_error,
+			    Qnative);
+	error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
+}
+/* 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);
+	if (s < 0)
+	  continue;
+	/* 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, 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) */
+	else /* EQ (protocol, Qudp) */
 	  svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
-if (svc_info == 0)
+	if (svc_info == 0)
-	error ("Unknown service \"%s\"", XSTRING_DATA (service));
+	  error ("Unknown service \"%s\"", XSTRING_DATA (service));
-port = svc_info->s_port;
+	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 ();
+	speed_up_interrupts ();
-REALLY_QUIT;
+	REALLY_QUIT;
-/* In case something really weird happens ... */
+	/* 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;
+	int xerrno = errno;
-if (errno == EINTR)
+	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;
-	}
+	if (errno == EADDRINUSE && retry < 20)
+	  {
-close (s);
+	    /* A delay here is needed on some FreeBSD systems,
+	       and it is harmless, since this retrying takes time anyway
-speed_up_interrupts ();
+	       and should be infrequent.
+	       `sleep-for' allowed for quitting this loop with interrupts
-errno = xerrno;
+	       slowed down so it can't be used here.  Async timers should
-report_file_error ("connection failed", list2 (host, name));
+	       already be disabled at this point so we can use `sleep'. */
-}
+	    sleep (1);
+	    retry++;
-speed_up_interrupts ();
+	    goto loop;
+	  }
+	close (s);
+	speed_up_interrupts ();
+	errno = xerrno;
+	report_file_error ("connection failed", list2 (host, name));
+}
+speed_up_interrupts ();
+#endif /* ! HAVE_GETADDRINFO */
+}
 inch = s;
 outch = dup (s);
 if (outch < 0)
 {

Mercurial > hg > xemacs-beta

comparison src/process-unix.c @ 440:8de8e3f6228a r21-2-28