update.
[chise/xemacs-chise.git.1] / src / process-unix.c
index f23a9e7..05b5046 100644 (file)
@@ -61,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
@@ -83,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
 /**********************************************************************/
@@ -152,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."
 */
 
@@ -179,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));
@@ -196,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
@@ -214,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
@@ -234,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 */
@@ -575,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
       }
   }
@@ -694,7 +818,7 @@ 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
@@ -718,8 +842,6 @@ 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;
@@ -770,6 +892,7 @@ unix_create_process (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.  */
@@ -779,7 +902,7 @@ unix_create_process (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;
@@ -792,17 +915,19 @@ unix_create_process (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 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 ();
+       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.
 
@@ -855,9 +980,22 @@ unix_create_process (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
@@ -891,7 +1029,7 @@ unix_create_process (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);
            }
 
@@ -928,9 +1066,7 @@ unix_create_process (Lisp_Process *p,
            }
          new_argv[i + 1] = 0;
 
            }
          new_argv[i + 1] = 0;
 
-         TO_EXTERNAL_FORMAT (LISP_STRING, cur_dir,
-                             C_STRING_ALLOCA, current_dir,
-                             Qfile_name);
+         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);
        }
@@ -938,14 +1074,16 @@ unix_create_process (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);
     }
 
@@ -1141,12 +1279,12 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
 
   /* #### JV: layering violation?
 
 
   /* #### JV: layering violation?
 
-     This function knows too much about the relation between the encodingstream
-     (DATA_OUTSTREAM) and te actual output stream p->output_stream.
+     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 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
@@ -1155,26 +1293,38 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
       Bufbyte chunkbuf[512];
       Bytecount chunklen;
 
       Bufbyte chunkbuf[512];
       Bytecount chunklen;
 
-      while (1)
+      do
        {
        {
-         ssize_t writeret;
+         Lstream_data_count writeret;
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
 
          chunklen = Lstream_read (lstream, chunkbuf, 512);
-         if (chunklen <= 0)
-           break; /* perhaps should abort() if < 0?
-                     This should never happen. */
          old_sigpipe =
            (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
          old_sigpipe =
            (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
-         /* Lstream_write() will never successfully write less than
-            the amount sent in.  In the worst case, it just buffers
-            the unwritten data. */
-         writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
-                                   chunklen);
-         signal (SIGPIPE, old_sigpipe);
-         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 (proc));
+         if (chunklen > 0)
+           {
+             int save_errno;
+
+             /* Lstream_write() will never successfully write less than
+                the amount sent in.  In the worst case, it just buffers
+                the unwritten data. */
+             writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
+                                       chunklen);
+             save_errno = errno;
+             signal (SIGPIPE, old_sigpipe);
+             errno = save_errno;
+             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 (proc));
+           }
+         else
+           {
+             /* Need to make sure that everything up to and including the
+                last chunk is flushed, even when the pipe is currently
+                blocked. */
+             Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
+             signal (SIGPIPE, old_sigpipe);
+           }
          while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
            {
              /* Buffer is full.  Wait, accepting input;
          while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
            {
              /* Buffer is full.  Wait, accepting input;
@@ -1189,7 +1339,9 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
              Lstream_flush (XLSTREAM (p->pipe_outstream));
              signal (SIGPIPE, old_sigpipe);
            }
              Lstream_flush (XLSTREAM (p->pipe_outstream));
              signal (SIGPIPE, old_sigpipe);
            }
+         /* Perhaps should abort() if < 0?  This should never happen. */
        }
        }
+      while (chunklen > 0);
     }
   else
     { /* We got here from a longjmp() from the SIGPIPE handler */
     }
   else
     { /* We got here from a longjmp() from the SIGPIPE handler */
@@ -1198,14 +1350,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++;
       deactivate_process (*((Lisp_Object *) (&vol_proc)));
       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));
+      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);
@@ -1272,7 +1426,17 @@ unix_deactivate_process (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.
@@ -1281,70 +1445,18 @@ unix_deactivate_process (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;
+  pid_t pgid = -1;
   Lisp_Process *p = XPROCESS (proc);
   Lisp_Process *p = XPROCESS (proc);
-
-  if (!UNIX_DATA(p)->pty_flag)
-    current_group = 0;
-
-  /* If we are using pgrps, get a pgrp number and make it negative.  */
-  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);
+  struct unix_process_data *d = UNIX_DATA (p);
 
   switch (signo)
     {
 
   switch (signo)
     {
@@ -1361,46 +1473,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)
@@ -1408,9 +1587,7 @@ 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
 unix_get_tty_name (Lisp_Process *p)
 
 static Lisp_Object
 unix_get_tty_name (Lisp_Process *p)
@@ -1418,11 +1595,8 @@ 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
 
 #ifdef HAVE_SOCKETS
 static Lisp_Object
@@ -1437,18 +1611,20 @@ unix_canonicalize_host_name (Lisp_Object host)
 
   xzero (hints);
   hints.ai_flags = AI_CANONNAME;
 
   xzero (hints);
   hints.ai_flags = AI_CANONNAME;
+#ifdef IPV6_CANONICALIZE
   hints.ai_family = AF_UNSPEC;
   hints.ai_family = AF_UNSPEC;
+#else
+  hints.ai_family = PF_INET;
+#endif
   hints.ai_socktype = SOCK_STREAM;
   hints.ai_protocol = 0;
   hints.ai_socktype = SOCK_STREAM;
   hints.ai_protocol = 0;
-  TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative);
+  LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
   retval = getaddrinfo (ext_host, NULL, &hints, &res);
   if (retval != 0)
     {
       char *gai_error;
 
   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);
+      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;
       maybe_error (Qprocess, ERROR_ME_NOT,
                   "%s \"%s\"", gai_error, XSTRING_DATA (host));
       canonname = host;
@@ -1478,11 +1654,11 @@ unix_canonicalize_host_name (Lisp_Object host)
 #endif /* ! HAVE_GETADDRINFO */
 }
 
 #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,
 
 static void
 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
@@ -1498,8 +1674,7 @@ 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 defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
 
   {
 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
@@ -1509,13 +1684,13 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
     volatile int xerrno = 0;
     volatile int failed_connect = 0;
     char *ext_host;
     volatile int xerrno = 0;
     volatile int failed_connect = 0;
     char *ext_host;
+    char portbuf[sizeof(long)*3 + 2];
     /*
      * Caution: service can either be a string or int.
      * Convert to a C string for later use by getaddrinfo.
      */
     if (INTP (service))
       {
     /*
      * 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));
        snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service));
        portstring = portbuf;
        port = htons ((unsigned short) XINT (service));
@@ -1523,9 +1698,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
     else
       {
        CHECK_STRING (service);
     else
       {
        CHECK_STRING (service);
-       TO_EXTERNAL_FORMAT (LISP_STRING, service,
-                           C_STRING_ALLOCA, portstring,
-                           Qnative);
+       LISP_STRING_TO_EXTERNAL (service, portstring, Qnative);
        port = 0;
       }
 
        port = 0;
       }
 
@@ -1537,15 +1710,13 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
     else /* EQ (protocol, Qudp) */
       hints.ai_socktype = SOCK_DGRAM;
     hints.ai_protocol = 0;
     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);
+    LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
     retval = getaddrinfo (ext_host, portstring, &hints, &res);
     if (retval != 0)
       {
        char *gai_error;
 
     retval = getaddrinfo (ext_host, portstring, &hints, &res);
     if (retval != 0)
       {
        char *gai_error;
 
-       TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
-                           C_STRING_ALLOCA, gai_error,
-                           Qnative);
+       EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative);
        error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
       }
 
        error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
       }
 
@@ -1621,6 +1792,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
 
            failed_connect = 1;
            close (s);
 
            failed_connect = 1;
            close (s);
+           s = -1;
 
            speed_up_interrupts ();
 
 
            speed_up_interrupts ();
 
@@ -1676,7 +1848,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
          svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
 
        if (svc_info == 0)
          svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
 
        if (svc_info == 0)
-         error ("Unknown service \"%s\"", XSTRING_DATA (service));
+         invalid_argument ("Unknown service", service);
        port = svc_info->s_port;
       }
 
        port = svc_info->s_port;
       }
 
@@ -1795,8 +1967,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;
@@ -1817,7 +1990,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)
@@ -1832,7 +2005,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 ------------------------ */
 
@@ -1852,10 +2025,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);
@@ -1921,7 +2094,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);