XEmacs 21.2.33 "Melpomene".
[chise/xemacs-chise.git.1] / src / process-unix.c
index 6be1c1a..f23a9e7 100644 (file)
@@ -1,4 +1,4 @@
-/* Asynchronous subprocess implemenation for UNIX
+/* Asynchronous subprocess implementation for UNIX
    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
@@ -28,6 +28,9 @@ Boston, MA 02111-1307, USA.  */
    Kirill M. Katsnelson <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)
@@ -37,11 +40,9 @@ Boston, MA 02111-1307, USA.  */
 #include "lisp.h"
 
 #include "buffer.h"
 #include "lisp.h"
 
 #include "buffer.h"
-#include "commands.h"
 #include "events.h"
 #include "frame.h"
 #include "hash.h"
 #include "events.h"
 #include "frame.h"
 #include "hash.h"
-#include "insdel.h"
 #include "lstream.h"
 #include "opaque.h"
 #include "process.h"
 #include "lstream.h"
 #include "opaque.h"
 #include "process.h"
@@ -62,7 +63,7 @@ Boston, MA 02111-1307, USA.  */
 
 
 /*
 
 
 /*
- * Implemenation-specific data. Pointed to by Lisp_Process->process_data
+ * Implementation-specific data. Pointed to by Lisp_Process->process_data
  */
 
 struct unix_process_data
  */
 
 struct unix_process_data
@@ -126,7 +127,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);
@@ -214,9 +215,11 @@ allocate_pty (void)
      end of the ptys.  */
   int failed_count = 0;
 #endif
      end of the ptys.  */
   int failed_count = 0;
 #endif
-  int i;
   int fd;
   int fd;
+#ifndef HAVE_GETPT
+  int i;
   int c;
   int c;
+#endif
 
 #ifdef PTY_ITERATION
   PTY_ITERATION
 
 #ifdef PTY_ITERATION
   PTY_ITERATION
@@ -236,7 +239,7 @@ allocate_pty (void)
 #else /* no PTY_OPEN */
 #ifdef IRIS
        /* Unusual IRIS code */
 #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)
        if (fd < 0)
          return -1;
        if (fstat (fd, &stb) < 0)
@@ -250,11 +253,7 @@ allocate_pty (void)
          }
        else
          failed_count = 0;
          }
        else
          failed_count = 0;
-#ifdef O_NONBLOCK
        fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
        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 */
 
 #endif /* not IRIS */
 #endif /* no PTY_OPEN */
 
@@ -267,7 +266,7 @@ allocate_pty (void)
 #else
             sprintf (pty_name, "/dev/tty%c%x", c, i);
 #endif /* no PTY_TTY_NAME_SPRINTF */
 #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);
            if (access (pty_name, 6) != 0)
              {
                close (fd);
@@ -314,6 +313,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)
@@ -369,9 +369,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;
@@ -390,7 +391,7 @@ set_socket_nonblocking_maybe (int fd, int port, CONST char* proto)
          else
            continue;
        }
          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;
     }
 
        break;
     }
 
@@ -409,7 +410,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;
@@ -524,7 +525,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()
@@ -653,7 +654,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);
 
@@ -669,14 +670,13 @@ unix_alloc_process_data (struct Lisp_Process *p)
  */
 
 static void
  */
 
 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
  */
 
 #ifdef SIGCHLD
@@ -698,52 +698,35 @@ unix_init_process (void)
  */
 
 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;
 }
 
 /*
- * 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.
  *
  * 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
  * 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. */
 
                     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.  */
   /* 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;
   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))
 
 #ifdef HAVE_PTYS
   if (!NILP (Vprocess_connection_type))
@@ -761,7 +744,7 @@ unix_create_process (struct Lisp_Process *p,
         better error checking. */
 #if !defined(USG)
       /* On USG systems it does not work to open the pty's tty here
         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).  */
 #ifdef O_NOCTTY
       /* Don't let this terminal become our controlling terminal
         (in case we don't have one).  */
@@ -802,14 +785,6 @@ unix_create_process (struct Lisp_Process *p,
     char **save_environ = environ;
 #endif
 
     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)
       {
     pid = fork ();
     if (pid == 0)
       {
@@ -925,28 +900,44 @@ unix_create_process (struct Lisp_Process *p,
               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
               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);
          }
            */
            signal (SIGHUP, SIG_DFL);
          }
+
+       if (pty_flag)
+         /* Set up the terminal characteristics of the pty. */
+         child_setup_tty (xforkout);
+
 #endif /* HAVE_PTYS */
 
 #endif /* HAVE_PTYS */
 
-       signal (SIGINT, SIG_DFL);
+       signal (SIGINT,  SIG_DFL);
        signal (SIGQUIT, 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
 #if !defined(__CYGWIN32__)
     environ = save_environ;
 #endif
@@ -986,32 +977,27 @@ unix_create_process (struct Lisp_Process *p,
 
 io_failure:
   {
 
 io_failure:
   {
-    int temp = errno;
+    int save_errno = errno;
     close_descriptor_pair (forkin, forkout);
     close_descriptor_pair (inchannel, outchannel);
     close_descriptor_pair (forkin, forkout);
     close_descriptor_pair (inchannel, outchannel);
-    errno = temp;
+    errno = save_errno;
     report_file_error ("Opening pty or pipe", Qnil);
     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
 
 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;
 }
 
-/*
- * This is called to set process' virtual terminal size
- */
+/* This is called to set process' virtual terminal size */
 
 static int
 
 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);
 }
@@ -1026,7 +1012,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
@@ -1052,7 +1038,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);
@@ -1132,7 +1118,7 @@ unix_reap_exited_processes (void)
 #endif /* SIGCHLD */
 
 /*
 #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;
  */
 
 static JMP_BUF send_process_frame;
@@ -1151,8 +1137,16 @@ 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 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
   if (!SETJMP (send_process_frame))
     {
       /* use a reasonable-sized buffer (somewhere around the size of the
@@ -1163,7 +1157,7 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
 
       while (1)
        {
 
       while (1)
        {
-         int writeret;
+         ssize_t writeret;
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
          if (chunklen <= 0)
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
          if (chunklen <= 0)
@@ -1180,14 +1174,16 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
          if (writeret < 0)
            /* This is a real error.  Blocking errors are handled
               specially inside of the filedesc stream. */
          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);
          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));
              old_sigpipe =
                (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
              Lstream_flush (XLSTREAM (p->pipe_outstream));
@@ -1207,7 +1203,7 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
       p->core_dumped = 0;
       p->tick++;
       process_tick++;
       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));
     }
       error ("SIGPIPE raised on process %s; closed it",
             XSTRING_DATA (p->name));
     }
@@ -1238,7 +1234,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;
 }
@@ -1254,11 +1250,11 @@ unix_process_send_eof (Lisp_Object proc)
  * In the lack of this method, only event_stream_delete_stream_pair
  * is called on both I/O streams of the process.
  *
  * 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
  */
 
 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;
@@ -1297,7 +1293,7 @@ unix_kill_child_process (Lisp_Object proc, int signo,
   int gid;
   int no_pgrp = 0;
   int kill_retval;
   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 (!UNIX_DATA(p)->pty_flag)
     current_group = 0;
@@ -1417,7 +1413,7 @@ unix_kill_process_by_pid (int pid, int sigcode)
  */
 
 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;
 }
@@ -1425,13 +1421,50 @@ unix_get_tty_name (struct Lisp_Process *p)
 /*
  * Canonicalize host name HOST, and return its canonical form
  *
 /*
  * 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)
 {
  */
 
 #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))
   struct sockaddr_in address;
 
   if (!get_internet_address (host, &address, ERROR_ME_NOT))
@@ -1442,6 +1475,7 @@ 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
 }
 
 /* open a TCP network connection to a given HOST/SERVICE.  Treated
@@ -1452,104 +1486,278 @@ unix_canonicalize_host_name (Lisp_Object host)
 
 static void
 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
 
 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);
 
   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;
          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);
@@ -1568,14 +1776,14 @@ 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
    TCP case, the multicast connection will be seen as a sub-process,
 
    Some notes:
 
    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.
    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.
@@ -1656,7 +1864,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port,
 
   /* Socket configuration for writing ----------------------- */
 
 
   /* 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. */
      '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. */