XEmacs 21.4.12 "Portable Code".
[chise/xemacs-chise.git.1] / src / process-unix.c
index b4a612e..0d57c95 100644 (file)
@@ -28,6 +28,9 @@ Boston, MA 02111-1307, USA.  */
    Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
    the original author(s) */
 
    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 <config.h>
 
 #if !defined (NO_SUBPROCESSES)
@@ -58,6 +61,9 @@ Boston, MA 02111-1307, USA.  */
 #include "systty.h"
 #include "syswait.h"
 
 #include "systty.h"
 #include "syswait.h"
 
+#ifdef HPUX
+#include <grp.h>               /* See grantpt fixups for HPUX below. */
+#endif
 
 /*
  * Implementation-specific data. Pointed to by Lisp_Process->process_data
 
 /*
  * Implementation-specific data. Pointed to by Lisp_Process->process_data
@@ -80,12 +86,6 @@ struct unix_process_data
 
 #define UNIX_DATA(p) ((struct unix_process_data*)((p)->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
 /**********************************************************************/
 
 \f
 /**********************************************************************/
@@ -124,7 +124,7 @@ close_descriptor_pair (int in, int out)
    to get rid of irrelevant descriptors.  */
 
 static int
    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);
 {
   Lisp_Object proc;
   CVOID_TO_LISP (proc, contents);
@@ -149,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:
 
 /* 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."
 */
 
  output, respectively."
 */
 
@@ -176,15 +176,16 @@ connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer,
   CHECK_INT (outfd);
 
   inch = XINT (infd);
   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;
   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));
   UNIX_DATA (XPROCESS (proc))->connected_via_filedesc_p = 1;
 
   event_stream_select_process (XPROCESS (proc));
@@ -193,16 +194,164 @@ connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer,
 }
 
 #ifdef HAVE_PTYS
 }
 
 #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
 
 /* 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)
 {
 
 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
   struct stat stb;
 
   /* Some systems name their pseudoterminals so that there are gaps in
@@ -211,19 +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;
      three failures in a row before deciding that we've reached the
      end of the ptys.  */
   int failed_count = 0;
-#endif
   int fd;
   int fd;
-#ifndef HAVE_GETPT
   int i;
   int c;
   int i;
   int c;
-#endif
 
 #ifdef PTY_ITERATION
   PTY_ITERATION
 #else
 
 #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++)
   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
       {
 #ifdef PTY_NAME_SPRINTF
        PTY_NAME_SPRINTF
@@ -231,53 +381,30 @@ allocate_pty (void)
        sprintf (pty_name, "/dev/pty%c%x", c, i);
 #endif /* no 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_NONBLOCK | 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;
        fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
              return -1;
          }
        else
          failed_count = 0;
        fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
-#endif /* not IRIS */
-#endif /* no PTY_OPEN */
 
        if (fd >= 0)
          {
 
        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 */
 #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 */
-#if !defined(UNIPLUS) && !defined(HAVE_GETPT)
-           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 */
   return -1;
 }
 #endif /* HAVE_PTYS */
@@ -310,6 +437,7 @@ create_bidirectional_pipe (int *inchannel, int *outchannel,
 
 #ifdef HAVE_SOCKETS
 
 
 #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)
 static int
 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
                      Error_behavior errb)
@@ -365,9 +493,10 @@ get_internet_address (Lisp_Object host, struct sockaddr_in *address,
 
   return 1;
 }
 
   return 1;
 }
+#endif /*  !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */
 
 static void
 
 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;
 {
 #ifdef PROCESS_IO_BLOCKING
   Lisp_Object tail;
@@ -405,7 +534,7 @@ set_socket_nonblocking_maybe (int fd, int port, CONST char* proto)
    the numeric status that was returned by `wait'.  */
 
 static void
    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;
 {
   /* C compiler lossage when attempting to pass w directly */
   int w = *w_fmh;
@@ -520,7 +649,7 @@ record_exited_processes (int block_sigchld)
 }
 
 /* For any processes that have changed status and are recorded
 }
 
 /* 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()
    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()
@@ -570,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 */
 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)
       {
 #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
 #ifdef SIGTSTP
-      case SIGTSTP: return CNTL('Z');
+      case SIGTSTP: return CNTL ('Z');
 #endif
       }
   }
 #endif
       }
   }
@@ -649,7 +778,7 @@ process_signal_char (int tty_fd, int signo)
  */
 
 static void
  */
 
 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);
 
 {
   p->process_data = xnew (struct unix_process_data);
 
@@ -665,7 +794,7 @@ unix_alloc_process_data (struct Lisp_Process *p)
  */
 
 static void
  */
 
 static void
-unix_mark_process_data (struct Lisp_Process *proc)
+unix_mark_process_data (Lisp_Process *proc)
 {
   mark_object (UNIX_DATA(proc)->tty_name);
 }
 {
   mark_object (UNIX_DATA(proc)->tty_name);
 }
@@ -689,11 +818,11 @@ 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
  * 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
  */
 
 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;
 }
 {
   UNIX_DATA(p)->infd = (int)in;
 }
@@ -709,12 +838,10 @@ unix_init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int f
  */
 
 static int
  */
 
 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)
 {
                     Lisp_Object *argv, int nargv,
                     Lisp_Object program, Lisp_Object cur_dir)
 {
-  /* This function rewritten by ben@xemacs.org. */
-
   int pid;
   int inchannel  = -1;
   int outchannel = -1;
   int pid;
   int inchannel  = -1;
   int outchannel = -1;
@@ -765,6 +892,7 @@ unix_create_process (struct Lisp_Process *p,
 #endif
 
   set_descriptor_non_blocking (inchannel);
 #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.  */
 
   /* Record this as an active process, with its channels.
      As a result, child_setup will close Emacs's side of the pipes.  */
@@ -774,7 +902,7 @@ unix_create_process (struct Lisp_Process *p,
   UNIX_DATA(p)->subtty = forkin;
 
   {
   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;
     /* child_setup must clobber environ on systems with true vfork.
        Protect it from permanent change.  */
     char **save_environ = environ;
@@ -787,17 +915,19 @@ unix_create_process (struct Lisp_Process *p,
        int xforkin = forkin;
        int xforkout = forkout;
 
        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.
 
            /* Open the pty connection and make the pty's terminal
               our controlling terminal.
 
@@ -850,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. */
 
                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
 
 #  ifdef TIOCSCTTY
            /* We ignore the return value
@@ -886,7 +1029,7 @@ unix_create_process (struct Lisp_Process *p,
               of our new controlling terminal. */
 
            {
               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);
            }
 
              EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly);
            }
 
@@ -923,7 +1066,7 @@ unix_create_process (struct Lisp_Process *p,
            }
          new_argv[i + 1] = 0;
 
            }
          new_argv[i + 1] = 0;
 
-         GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir);
+         LISP_STRING_TO_EXTERNAL (cur_dir, current_dir, Qfile_name);
 
          child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
        }
 
          child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
        }
@@ -931,14 +1074,16 @@ unix_create_process (struct Lisp_Process *p,
       } /**** End of child code ****/
 
     /**** Back in parent process ****/
       } /**** End of child code ****/
 
     /**** Back in parent process ****/
-#if !defined(__CYGWIN32__)
+#if !defined(CYGWIN)
     environ = save_environ;
 #endif
   }
 
   if (pid < 0)
     {
     environ = save_environ;
 #endif
   }
 
   if (pid < 0)
     {
+      int save_errno = errno;
       close_descriptor_pair (forkin, forkout);
       close_descriptor_pair (forkin, forkout);
+      errno = save_errno;
       report_file_error ("Doing fork", Qnil);
     }
 
       report_file_error ("Doing fork", Qnil);
     }
 
@@ -982,7 +1127,7 @@ io_failure:
 /* Return nonzero if this process is a ToolTalk connection. */
 
 static int
 /* 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;
 }
 {
   return UNIX_DATA(p)->connected_via_filedesc_p;
 }
@@ -990,7 +1135,7 @@ unix_tooltalk_connection_p (struct Lisp_Process *p)
 /* This is called to set process' virtual terminal size */
 
 static int
 /* 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);
 }
 {
   return set_window_size (UNIX_DATA(p)->infd, cols, rows);
 }
@@ -1005,7 +1150,7 @@ unix_set_window_size (struct Lisp_Process* p, int cols, int rows)
 
 #ifdef HAVE_WAITPID
 static void
 
 #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
 {
   int w;
 #ifdef SIGCHLD
@@ -1031,7 +1176,7 @@ static void
 unix_reap_exited_processes (void)
 {
   int i;
 unix_reap_exited_processes (void)
 {
   int i;
-  struct Lisp_Process *p;
+  Lisp_Process *p;
 
 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
   record_exited_processes (1);
 
 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
   record_exited_processes (1);
@@ -1130,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;
   /* 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))
     {
 
   if (!SETJMP (send_process_frame))
     {
@@ -1142,7 +1295,7 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
 
       while (1)
        {
 
       while (1)
        {
-         int writeret;
+         Lstream_data_count writeret;
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
          if (chunklen <= 0)
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
          if (chunklen <= 0)
@@ -1166,6 +1319,9 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
                 that may allow the program
                 to finish doing output and read more.  */
              Faccept_process_output (Qnil, make_int (1), Qnil);
                 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));
              old_sigpipe =
                (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
              Lstream_flush (XLSTREAM (p->pipe_outstream));
@@ -1180,14 +1336,16 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
       /* #### There is controversy over whether this might cause fd leakage */
       /*      my tests say no. -slb */
       XLSTREAM (p->pipe_outstream)->flags &= ~LSTREAM_FL_IS_OPEN;
       /* #### 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++;
       p->status_symbol = Qexit;
       p->exit_code = 256; /* #### SIGPIPE ??? */
       p->core_dumped = 0;
       p->tick++;
       process_tick++;
-      deactivate_process (*((Lisp_Object *) (&vol_proc)));
-      error ("SIGPIPE raised on process %s; closed it",
-            XSTRING_DATA (p->name));
+      deactivate_process (vol_proc);
+      invalid_operation ("SIGPIPE raised on process; closed it", p->name);
     }
 
   old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
     }
 
   old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
@@ -1216,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
   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;
 }
 #endif
   return 1;
 }
@@ -1236,7 +1394,7 @@ unix_process_send_eof (Lisp_Object proc)
  */
 
 static USID
  */
 
 static USID
-unix_deactivate_process (struct Lisp_Process *p)
+unix_deactivate_process (Lisp_Process *p)
 {
   SIGTYPE (*old_sigpipe) (int) = 0;
   USID usid;
 {
   SIGTYPE (*old_sigpipe) (int) = 0;
   USID usid;
@@ -1254,7 +1412,17 @@ unix_deactivate_process (struct Lisp_Process *p)
   return 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.
    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.
@@ -1263,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
 
    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)
 {
 
 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)
     {
 
   switch (signo)
     {
@@ -1343,46 +1459,113 @@ unix_kill_child_process (Lisp_Object proc, int signo,
     case SIGINT:
     case SIGQUIT:
     case SIGKILL:
     case SIGINT:
     case SIGQUIT:
     case SIGKILL:
-      flush_pending_output (UNIX_DATA(p)->infd);
+      flush_pending_output (d->infd);
       break;
     }
 
       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)
 
 static int
 unix_kill_process_by_pid (int pid, int sigcode)
@@ -1390,26 +1573,60 @@ unix_kill_process_by_pid (int pid, int sigcode)
   return kill (pid, sigcode);
 }
 
   return kill (pid, sigcode);
 }
 
-/*
- * Return TTY name used to communicate with subprocess
- */
+/* Return TTY name used to communicate with subprocess. */
 
 static Lisp_Object
 
 static Lisp_Object
-unix_get_tty_name (struct Lisp_Process *p)
+unix_get_tty_name (Lisp_Process *p)
 {
   return UNIX_DATA (p)->tty_name;
 }
 
 {
   return UNIX_DATA (p)->tty_name;
 }
 
-/*
- * Canonicalize host name HOST, and return its canonical form
- *
- * The default implementation 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)
 {
 
 #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))
   struct sockaddr_in address;
 
   if (!get_internet_address (host, &address, ERROR_ME_NOT))
@@ -1420,19 +1637,19 @@ unix_canonicalize_host_name (Lisp_Object host)
   else
     /* #### any clue what to do here? */
     return 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 protocol, void** vinfd, void** voutfd)
 {
 
 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;
   int inch;
   int outch;
   volatile int s;
@@ -1443,102 +1660,262 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
   CHECK_STRING (host);
 
   if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
   CHECK_STRING (host);
 
   if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
-    error ("Unsupported protocol \"%s\"",
-          string_data (symbol_name (XSYMBOL (protocol))));
+    invalid_argument ("Unsupported protocol", protocol);
 
 
-  if (INTP (service))
-    port = htons ((unsigned short) XINT (service));
-  else
-    {
-      struct servent *svc_info;
-      CHECK_STRING (service);
+  {
+#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;
+      }
+
+    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;
+
+       EXTERNAL_TO_C_STRING (gai_strerror (retval), 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);
+           s = -1;
+
+           speed_up_interrupts ();
 
 
-      if (EQ (protocol, Qtcp))
+           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");
          svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
-      else /* EQ (protocol, Qudp) */
+       else /* EQ (protocol, Qudp) */
          svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
 
          svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
 
-      if (svc_info == 0)
-       error ("Unknown service \"%s\"", XSTRING_DATA (service));
-      port = svc_info->s_port;
-    }
+       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;
+    get_internet_address (host, &address, ERROR_ME);
+    address.sin_port = port;
 
 
-  if (EQ (protocol, Qtcp))
+    if (EQ (protocol, Qtcp))
       s = socket (address.sin_family, SOCK_STREAM, 0);
       s = socket (address.sin_family, SOCK_STREAM, 0);
-  else /* EQ (protocol, Qudp) */
+    else /* EQ (protocol, Qudp) */
       s = socket (address.sin_family, SOCK_DGRAM, 0);
 
       s = socket (address.sin_family, SOCK_DGRAM, 0);
 
-  if (s < 0)
-    report_file_error ("error creating socket", list1 (name));
+    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. */
+    /* 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: */
+    /* 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.  */
+    /* 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 polling.  Some kernels have a bug which causes retrying
+       connect to fail after a connect.  */
 
 
-  slow_down_interrupts ();
+    slow_down_interrupts ();
 
 
- loop:
+  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 ();
-    }
+    /* 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++;
+    /* 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;
          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);
 
   inch = s;
   outch = dup (s);
@@ -1557,7 +1934,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
 
 #ifdef HAVE_MULTICAST
 
 
 #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
 
    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
@@ -1576,8 +1953,9 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
 */
 
 static void
 */
 
 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;
 {
   struct ip_mreq imr;
   struct sockaddr_in sa;
@@ -1598,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)
   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)
 
   /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */
   if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
@@ -1613,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;
   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 ------------------------ */
 
 
   /* Socket configuration for reading ------------------------ */
 
@@ -1633,10 +2011,10 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port,
     }
 
   /* join multicast group */
     }
 
   /* 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,
   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);
     {
       close (ws);
       close (rs);
@@ -1702,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,
 
   /* scope */
   if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
-                 (char *) &thettl, sizeof (thettl)) < 0)
+                 &thettl, sizeof (thettl)) < 0)
     {
       close (rs);
       close (ws);
     {
       close (rs);
       close (ws);