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

comparison src/process-unix.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 #include "systime.h"
 #include "syssignal.h" /* Always include before systty.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
 */
 char pty_flag;
 };
 #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
 /**********************************************************************/
 /*                    Static helper routines                          */
 /**********************************************************************/
 /* Close all descriptors currently in use for communication
 with subprocess.  This is used in a newly-forked subprocess
 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);
 event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream,
 				   XPROCESS(proc)->pipe_outstream);
 communication. */
 /* 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\
+"Connect to an existing file descriptor.
-Returns a subprocess-object to represent the connection.\n\
+Return a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.\n\
+Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER INFD OUTFD.\n\
+Args are NAME BUFFER INFD OUTFD.
-NAME is name for process.  It is modified if necessary to make it unique.\n\
+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.\n\
+BUFFER is the buffer (or buffer-name) to associate with the process.
-Process output goes at end of that buffer, unless you specify\n\
+Process output goes at end of that buffer, unless you specify
-an output stream or filter function to handle the output.\n\
+an output stream or filter function to handle the output.
-BUFFER may be also nil, meaning that this process is not associated\n\
+BUFFER may also be nil, meaning that this process is not associated
-with any buffer\n\
+with any buffer.
-INFD and OUTFD specify the file descriptors to use for input and\n\
+INFD and OUTFD specify the file descriptors to use for input and
 output, respectively."
 */
 Lisp_Object
 connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer,
 CHECK_STRING (name);
 CHECK_INT (infd);
 CHECK_INT (outfd);
 inch = XINT (infd);
-if (get_process_from_usid (FD_TO_USID(inch)))
+if (get_process_from_usid (FD_TO_USID (inch)))
-error ("There is already a process connected to fd %d", 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;
-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));
 return proc;
 }
 #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
-is left in the variable pty_name.  */
+is left in the variable `pty_name'.  */
 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(). */
+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);
+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
 the usual sequence - for example, on HP9000/S700 systems, there
 are no pseudoterminals with names ending in 'f'.  So we wait for
 three failures in a row before deciding that we've reached the
 end of the ptys.  */
 int failed_count = 0;
-#endif
 int fd;
-#ifndef HAVE_GETPT
 int i;
 int c;
-#endif
 #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++)
-#endif
+#endif /* PTY_ITERATION */
 {
 #ifdef PTY_NAME_SPRINTF
 	PTY_NAME_SPRINTF
 #else
 	sprintf (pty_name, "/dev/pty%c%x", c, i);
 #endif /* no PTY_NAME_SPRINTF */
-#ifdef PTY_OPEN
+	if (xemacs_stat (pty_name, &stb) < 0)
-	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)
 	  {
-	    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);
-#endif /* not IRIS */
-#endif /* no PTY_OPEN */
 	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 */
-#if !defined(UNIPLUS) && !defined(HAVE_GETPT)
+	    if (access (pty_name, R_OK | W_OK) == 0)
-	    if (access (pty_name, 6) != 0)
 	      {
-		close (fd);
+		setup_pty (fd);
-#if !defined(IRIS) && !defined(__sgi)
+		return fd;
-		continue;
-#else
-		return -1;
-#endif /* IRIS */
 	      }
-#endif /* not UNIPLUS */
+	    close (fd);
-	    setup_pty (fd);
-	    return fd;
 	  }
-}
+} /* iteration */
 return -1;
 }
 #endif /* HAVE_PTYS */
 static int
 return 1;
 }
 #endif /*  !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */
 static void
-set_socket_nonblocking_maybe (int fd, int port, CONST char* proto)
+set_socket_nonblocking_maybe (int fd, int port, const char* proto)
 {
 #ifdef PROCESS_IO_BLOCKING
 Lisp_Object tail;
 for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail))
 static int
 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)
 {
-case SIGINT:  return CNTL('C');
+case SIGINT:  return CNTL ('C');
-case SIGQUIT: return CNTL('\\');
+case SIGQUIT: return CNTL ('\\');
 #ifdef SIGTSTP
-case SIGTSTP: return CNTL('Z');
+case SIGTSTP: return CNTL ('Z');
 #endif
 }
 }
 #ifdef HAVE_TERMIOS
 /*
 * 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
 unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
 {
 static int
 unix_create_process (Lisp_Process *p,
 		     Lisp_Object *argv, int nargv,
 		     Lisp_Object program, Lisp_Object cur_dir)
 {
-/* This function rewritten by ben@xemacs.org. */
 int pid;
 int inchannel  = -1;
 int outchannel = -1;
 /* Use volatile to protect variables from being clobbered by longjmp.  */
 volatile int forkin   = -1;
 			   pty_flag ? STREAM_PTY_FLUSHING : 0);
 /* Record the tty descriptor used in the subprocess.  */
 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;
 #endif
 {
 	/**** Now we're in the child process ****/
 	int xforkin = forkin;
 	int xforkout = forkout;
-	if (!pty_flag)
+	/* Disconnect the current controlling terminal, pursuant to
-	  EMACS_SEPARATE_PROCESS_GROUP ();
+	   making the pty be the controlling terminal of the process.
+	   Also put us in our own process group. */
+	disconnect_controlling_terminal ();
 #ifdef HAVE_PTYS
-	else
+	if (pty_flag)
 	  {
-	    /* 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 ();
 	    /* Open the pty connection and make the pty's terminal
 	       our controlling terminal.
 	       On systems with TIOCSCTTY, we just use it to set
 	       the controlling terminal.  On other systems, the
 	    /* Miscellaneous setup required for some systems.
 Must be done before using tc* functions on xforkin.
 This guarantees that isatty(xforkin) is true. */
-# ifdef SETUP_SLAVE_PTY
+#  if defined (HAVE_ISASTREAM) && defined (I_PUSH)
-	    SETUP_SLAVE_PTY;
+	    if (isastream (xforkin))
-# endif /* SETUP_SLAVE_PTY */
+	      {
+#    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
 	       because faith@cs.unc.edu says that is necessary on Linux.  */
 assert (isatty (xforkin));
 	    /* Make our process group be the foreground group
 	       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);
 	    }
 	    /* On AIX, we've disabled SIGHUP above once we start a
 	       child on a pty.  Now reenable it in the child, so it
 	      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,
+	  LISP_STRING_TO_EXTERNAL (cur_dir, current_dir, Qfile_name);
-			      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__)
+#if !defined(CYGWIN)
 environ = save_environ;
 #endif
 }
 if (pid < 0)
 {
+int save_errno = errno;
 close_descriptor_pair (forkin, forkout);
+errno = save_errno;
 report_file_error ("Doing fork", Qnil);
 }
 /* #### dmoore - why is this commented out, otherwise we leave
 subtty = forkin, but then we close forkin just below. */
 /* Use volatile to protect variables from being clobbered by longjmp.  */
 SIGTYPE (*volatile old_sigpipe) (int) = 0;
 volatile Lisp_Object vol_proc = 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))
 {
 /* use a reasonable-sized buffer (somewhere around the size of the
 	 stream buffer) so as to avoid inundating the stream with blocked
 	 data. */
 	    {
 	      /* 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));
 	      signal (SIGPIPE, old_sigpipe);
 	    }
 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",
+invalid_operation ("SIGPIPE raised on process; closed it", p->name);
-	     XSTRING_DATA (p->name));
 }
 old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
 Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
 signal (SIGPIPE, old_sigpipe);
 things up. */
 #if 0
 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;
 }
 /*
 UNIX_DATA(p)->infd  = -1;
 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 (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.
 If NOMSG is zero, insert signal-announcements into process's buffers
 right away.
 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)
 {
-int gid;
+pid_t pgid = -1;
-int no_pgrp = 0;
-int kill_retval;
 Lisp_Process *p = XPROCESS (proc);
+struct unix_process_data *d = UNIX_DATA (p);
-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);
 switch (signo)
 {
 #ifdef SIGCONT
 case SIGCONT:
 break;
 #endif /* ! defined (SIGCONT) */
 case SIGINT:
 case SIGQUIT:
 case SIGKILL:
-flush_pending_output (UNIX_DATA(p)->infd);
+flush_pending_output (d->infd);
 break;
 }
-/* If we don't have process groups, send the signal to the immediate
+if (! d->pty_flag)
-subprocess.  That isn't really right, but it's better than any
+current_group = 0;
-obvious alternative.  */
-if (no_pgrp)
+/* If current_group is true, we want to send a signal to the
-{
+foreground process group of the terminal our child process is
-kill_retval = kill (XINT (p->pid), signo) ? errno : 0;
+running on.  You would think that would be easy.
-}
-else
+The BSD people invented the TIOCPGRP ioctl to get the foreground
-{
+process group of a tty.  That, combined with killpg, gives us
-/* gid may be a pid, or minus a pgrp's number */
+what we want.
-#if defined (TIOCSIGNAL) || defined (TIOCSIGSEND)
-if (current_group)
+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.  On some systems none of these work, so then
+we just fall back to the non-current_group behavior and kill the
+process group of the child. */
+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
+	  /* Many systems provide an ioctl to send a signal directly */
-	  kill_retval = ioctl (UNIX_DATA(p)->infd, TIOCSIGNAL, signo);
+#ifdef TIOCSIGNAL /* Solaris, HP-UX */
-#else /* ! defined (TIOCSIGNAL) */
+	  if (ioctl (d->infd, TIOCSIGNAL, signo) != -1)
-	  kill_retval = ioctl (UNIX_DATA(p)->infd, TIOCSIGSEND, signo);
+	    return;
-#endif /* ! defined (TIOCSIGNAL) */
+#endif /* TIOCSIGNAL */
+#ifdef TIOCSIG /* BSD */
+	  if (ioctl (d->infd, TIOCSIG, signo) != -1)
+	    return;
+#endif /* TIOCSIG */
 	}
-else
+} /* current_group */
-	kill_retval = kill (- XINT (p->pid), signo) ? errno : 0;
-#else /* ! (defined (TIOCSIGNAL) || defined (TIOCSIGSEND)) */
+if (pgid == -1)
-kill_retval = EMACS_KILLPG (-gid, signo) ? errno : 0;
+/* Either current_group is 0, or we failed to get the foreground
-#endif /* ! (defined (TIOCSIGNAL) || defined (TIOCSIGSEND)) */
+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,
-if (kill_retval < 0 && errno == EINVAL)
+the shell's subprocess is killed, which is the desired effect.
-error ("Signal number %d is invalid for this system", signo);
+The process group of p->pid is always p->pid, since it was
-}
+created as a process group leader. */
+pgid = XINT (p->pid);
-/*
-* Kill any process in the system given its PID.
+/* Finally send the signal. */
-*
+if (EMACS_KILLPG (pgid, signo) == -1)
-* Returns zero if a signal successfully sent, or
+error ("kill (%ld, %ld) failed: %s",
-* negative number upon failure
+	   (long) pgid, (long) signo, strerror (errno));
-*/
+}
+/* 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)
 {
 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)
 {
 return UNIX_DATA (p)->tty_name;
 }
-/*
+/* Canonicalize host name HOST, and return its canonical form.
-* Canonicalize host name HOST, and return its canonical form
+The default implementation 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)
 {
 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);
+LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
 retval = getaddrinfo (ext_host, NULL, &hints, &res);
 if (retval != 0)
 {
 char *gai_error;
-TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
+EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative);
-			  C_STRING_ALLOCA, gai_error,
-			  Qnative);
 maybe_error (Qprocess, ERROR_ME_NOT,
 		   "%s \"%s\"", gai_error, XSTRING_DATA (host));
 canonname = 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.
-exactly like a normal process when reading and writing.  Only
+Treated exactly like a normal process when reading and writing.
-differences are in status display and process deletion.  A network
+Only differences are in status display and process deletion.
-connection has no PID; you cannot signal it.  All you can do is
+A network connection has no PID; you cannot signal it.  All you can
-deactivate and close it via delete-process */
+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)
 {
 int retval;
 CHECK_STRING (host);
 if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
-error ("Unsupported protocol \"%s\"",
+invalid_argument ("Unsupported protocol", protocol);
-	   string_data (symbol_name (XSYMBOL (protocol))));
 {
 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
 struct addrinfo hints, *res;
 struct addrinfo * volatile lres;
 	port = htons ((unsigned short) XINT (service));
 }
 else
 {
 	CHECK_STRING (service);
-	TO_EXTERNAL_FORMAT (LISP_STRING, service,
+	LISP_STRING_TO_EXTERNAL (service, portstring, Qnative);
-			    C_STRING_ALLOCA, portstring,
-			    Qnative);
 	port = 0;
 }
 xzero (hints);
 hints.ai_flags = 0;
 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);
+LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
 retval = getaddrinfo (ext_host, portstring, &hints, &res);
 if (retval != 0)
 {
 	char *gai_error;
-	TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
+	EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative);
-			    C_STRING_ALLOCA, gai_error,
-			    Qnative);
 	error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
 }
 /* address loop */
 for (lres = res; lres ; lres = lres->ai_next)
 	  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));
+	  invalid_argument ("Unknown service", service);
 	port = svc_info->s_port;
 }
 get_internet_address (host, &address, ERROR_ME);
 address.sin_port = port;
 }
 #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,
 about the kind of connection we have. However, this is not such an
 important issue.
 */
 static void
-unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port,
+unix_open_multicast_group (Lisp_Object name, Lisp_Object dest,
-			   Lisp_Object ttl, void** vinfd, void** voutfd)
+			   Lisp_Object port, Lisp_Object ttl, void** vinfd,
+			   void** voutfd)
 {
 struct ip_mreq imr;
 struct sockaddr_in sa;
 struct protoent *udp;
 int ws, rs;
 CHECK_NATNUM (ttl);
 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)
 report_file_error ("error creating socket", list1(name));
 if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
 /* join multicast group */
 imr.imr_multiaddr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest)));
 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);
 report_file_error ("error adding membership", list2(name, dest));
 }
 speed_up_interrupts ();
 /* scope */
 if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
-		  (char *) &thettl, sizeof (thettl)) < 0)
+		  &thettl, sizeof (thettl)) < 0)
 {
 close (rs);
 close (ws);
 report_file_error ("error setting ttl", list2(name, ttl));
 }

Mercurial > hg > xemacs-beta

comparison src/process-unix.c @ 442:abe6d1db359e r21-2-36