scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use system-dependent facilities to open a new pty.

This commit is contained in:
mainzelm 2006-03-29 13:24:43 +00:00
parent 89d3cc13e5
commit 2e37299496
5 changed files with 344 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
configure.in
View File

@ -316,7 +316,7 @@ AC_INIT(c/scheme48vm.c)
## The GNU Hurd
*-*-gnu* )
machine=gnu
dir=gnu
SCSH_ELF
;;
@ -395,6 +395,47 @@ fail
AC_STRUCT_TIMEZONE
AC_CHECK_MEMBER(struct tm.tm_gmtoff,
AC_DEFINE(HAVE_GMTOFF, 1, [Define to 1 if struct tm has member tm_gmtoff]))
dnl ----------------------------------------------------------------
dnl Check for pty support
dnl ----------------------------------------------------------------
dnl There is no "standard" pty allocation method. Every system is different.
dnl getpt() is the preferred pty allocation method on glibc systems.
dnl _getpty() is the preferred pty allocation method on SGI systems.
dnl grantpt(), unlockpt(), ptsname() are defined by Unix98.
AC_CHECK_FUNCS(getpt _getpty grantpt unlockpt ptsname killpg tcgetpgrp)
dnl openpty() is the preferred pty allocation method on BSD and Tru64 systems.
dnl openpty() might be declared in:
dnl - pty.h (Tru64 or Linux)
dnl - libutil.h (FreeBSD)
dnl - util.h (NetBSD)
AC_CHECK_FUNC(openpty, have_openpty=yes, [
AC_CHECK_LIB(util, openpty, have_openpty=yes need_libutil=yes)])
if test "$have_openpty" = "yes"; then
AC_DEFINE(HAVE_OPENPTY, 1, [Define to 1 if you have the 'openpty' function])
AC_CHECK_HEADERS(libutil.h util.h, break)
if test "$need_libutil" = "yes"; then
LIBS="${LIBS} -lutil"
fi
fi
dnl Check for system-specific pty header files
dnl Often the TIOCSIG* symbols are hiding there.
case "$opsys" in
dnl HPUX pty.h #defines TRUE and FALSE, so just use ptyio.h there.
hpux*) AC_CHECK_HEADERS(sys/ptyio.h) ;;
*) AC_CHECK_HEADERS(pty.h)
test "$ac_cv_header_pty_h" = "no" && AC_CHECK_HEADERS(sys/pty.h)
;;
esac
dnl Check for System V STREAM support functions.
AC_CHECK_HEADERS(stropts.h)
AC_CHECK_FUNCS(isastream)
SCSH_CONST_SYS_ERRLIST
CFLAGS1=${CFLAGS}

36
scsh/pty.scm
View File

@ -18,20 +18,22 @@
(define (fork-pty-session thunk)
(receive (pty-in ttyname) (open-pty)
(let* ((process (fork (lambda ()
(close-input-port pty-in)
(become-session-leader)
(let ((tty (open-control-tty ttyname)))
(move->fdes tty 0)
(dup->outport tty 1)
(dup->outport tty 2))
(let ((tty-in (open-file ttyname open/read+write)))
(let* ((process (fork (lambda ()
(close-input-port pty-in)
(become-session-leader)
(make-control-tty tty-in)
(move->fdes tty-in 0)
(dup->outport tty-in 1)
(dup->outport tty-in 2)
; (set-port-buffering (dup->outport tty 2)
; bufpol/none))
(with-stdio-ports* thunk))))
(pty-out (dup->outport pty-in)))
(with-stdio-ports* thunk))))
(pty-out (dup->outport pty-in)))
(close-input-port tty-in)
; (set-port-buffering pty-out bufpol/none)
(values process pty-in pty-out ttyname))))
(values process pty-in pty-out ttyname))))
)
;;; (open-pty)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -44,7 +46,8 @@
;;; opened read+write, and you can use DUP->OUTPORT to map it to
;;; corresponding output ports.
(define (open-pty)
(define (open-pty-from-devname)
(warn "calling open-pty-from-devname")
(let ((next-pty (make-pty-generator)))
(let loop ()
(cond ((next-pty) =>
@ -58,6 +61,15 @@
(else (error "open-pty: could not open new pty"))))))
(import-os-error-syscall allocate-pty () "allocate_pty")
(define (open-pty)
(let ((pty-fd.tty-name (allocate-pty)))
(if pty-fd.tty-name
(values (make-input-fdport (car pty-fd.tty-name) 0)
(cdr pty-fd.tty-name))
(open-pty-from-devname))))
;;; The following code may in fact be system dependent.
;;; If so, we'll move it out to the architecture specific directories.

1
scsh/scsh-interfaces.scm
View File

@ -1038,6 +1038,7 @@
decode-baud-rate
open-control-tty
make-control-tty
set-tty-process-group
tty-process-group

7
scsh/tty.scm
View File

@ -111,6 +111,8 @@
(define (tty-info . maybe-fdport)
(let ((control-chars (make-string num-ttychars))
(fdport (:optional maybe-fdport (current-input-port))))
(if (not (tty? fdport))
(error "Argument to tty-info is not a tty" fdport))
(apply
(lambda (iflag oflag cflag lflag ispeed-code ospeed-code)
(make-%tty-info control-chars
@ -334,6 +336,11 @@
(import-os-error-syscall %open-control-tty (ttyname flags) "open_ctty")
(define (make-control-tty fd/port)
(sleazy-call/fdes fd/port %make-control-tty))
(import-os-error-syscall %make-control-tty (fd) "make_ctty")
;;; Random bits & pieces: isatty ttyname ctermid
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (tty? fd/port) -> boolean

271
scsh/tty1.c
View File

@ -10,15 +10,63 @@
* Copyright (c) 1995 by Brian D. Carlstrom
* Re-written by Olin.
*/
#include "sysdep.h"
#include <stdlib.h>
#include <unistd.h>
#include <stdio.h> /* ctermid decl */
#include <termios.h>
#include <string.h>
#include <sys/types.h>
#include <errno.h>
#include <fcntl.h>
#include <signal.h>
#include "scheme48.h"
#ifdef HAVE_STROPTS_H
#include <stropts.h>
#endif
#ifdef HAVE_PTY_H
#include <pty.h> /* openpty() on Tru64, Linux */
#endif
#ifdef HAVE_LIBUTIL_H
#include <libutil.h> /* openpty() on FreeBSD */
#endif
#ifdef HAVE_UTIL_H
#include <util.h> /* openpty() on NetBSD */
#endif
#ifndef countof
# define countof(x) (sizeof (x) / sizeof (*(x)))
#endif
#define INTERRUPTIBLE_CLOSE
int
retry_close (int filedes)
{
#ifdef INTERRUPTIBLE_CLOSE
int did_retry = 0;
int rtnval;
while ((rtnval = close (filedes)) == -1
&& (errno == EINTR))
did_retry = 1;
/* If close is interrupted SunOS 4.1 may or may not have closed the
file descriptor. If it did the second close will fail with
errno = EBADF. That means we have succeeded. */
if (rtnval == -1 && did_retry && errno == EBADF)
return 0;
return rtnval;
#else
return close (filedes);
#endif
}
/* This #include is for the #ifdef'd code in open_ctty() below, and
** is therefor ifdef'd identically.
*/
@ -38,6 +86,14 @@ s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars)
int *ispeed, int *ospeed)*/
{
struct termios t;
int fd = s48_extract_fixnum(sch_fd);
if (isatty(fd) == 0) {
fprintf(stderr, "%d is not a tty\n", fd);
return S48_FALSE;
}
int result = tcgetattr(s48_extract_fixnum (sch_fd), &t);
int i;
s48_value sch_iflag = S48_UNSPECIFIC;
@ -210,6 +266,39 @@ s48_value open_ctty(s48_value sch_ttyname, s48_value sch_flags)
return s48_enter_fixnum (fd);
}
s48_value make_ctty(s48_value sch_fd)
{
int fd = s48_extract_fixnum (sch_fd);
#if defined (HAVE_ISASTREAM) && defined (I_PUSH)
if (isastream (fd))
{
# 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 (fd, "ptem"))
ioctl (fd, I_PUSH, "ptem");
if (! stream_module_pushed (fd, "ldterm"))
ioctl (fd, I_PUSH, "ldterm");
if (! stream_module_pushed (fd, "ttcompat"))
ioctl (fd, I_PUSH, "ttcompat");
}
#endif /* defined (HAVE_ISASTREAM) && defined (I_PUSH) */
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(__hpux)
/* 4.3+BSD way to acquire control tty. !CIBAUD rules out SunOS.
** This code stolen from Steven's *Advanced Prog. in the Unix Env.*
*/
if( (fd >= 0) && (ioctl(fd, TIOCSCTTY, (char *) 0) < 0) ) {
s48_raise_os_error_1 (errno, sch_fd);
}
#endif
return S48_UNSPECIFIC;
}
s48_value sch_isatty (s48_value sch_fd)
{
return ((isatty (s48_extract_fixnum (sch_fd))) ? S48_TRUE : S48_FALSE);
@ -231,6 +320,184 @@ s48_value scm_ctermid()
return s48_enter_string (ret);
}
static int allocate_master (const char**, const char **);
static const char* allocate_slave_name(int, const char*);
#define BLOCK_SIGNAL(sig) do \
{ \
sigset_t sig_mask; \
sigemptyset (&sig_mask); \
sigaddset (&sig_mask, sig); \
sigprocmask (SIG_BLOCK, &sig_mask, NULL); \
} while (0)
#define UNBLOCK_SIGNAL(sig) do \
{ \
sigset_t sig_mask; \
sigemptyset (&sig_mask); \
sigaddset (&sig_mask, sig); \
sigprocmask (SIG_UNBLOCK, &sig_mask, NULL); \
} while (0)
/* Open an available pty, returning a file descriptor.
Return -1 on failure. */
allocate_pty (void)
{
/* 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;
s48_value scm_slave_name = S48_UNSPECIFIC;
master_fd = allocate_master(&slave_name, &clone);
if (master_fd == -1)
return S48_FALSE;
if (slave_name == NULL){
slave_name = allocate_slave_name(master_fd, clone);
if (slave_name == NULL){
retry_close (master_fd);
return S48_FALSE;
}
}
scm_slave_name = s48_enter_string((char *) slave_name);
#ifdef TIOCPKT
/* In some systems (Linux through 2.0.0, at least), packet mode doesn't
get cleared when a pty is closed, so we need to clear it here.
Linux pre2.0.13 contained an attempted fix for this (from Ted Ts'o,
tytso@mit.edu), but apparently it messed up rlogind and telnetd, so he
removed the fix in pre2.0.14. - dkindred@cs.cmu.edu
*/
int off = 0;
ioctl (master_fd, TIOCPKT, (char *)&off);
#endif /* TIOCPKT */
/* 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)
BLOCK_SIGNAL (SIGCHLD);
#if defined (HAVE_GRANTPT)
grantpt (master_fd);
#endif /* HAVE_GRANTPT */
#if defined (HAVE_UNLOCKPT)
unlockpt (master_fd);
#endif
UNBLOCK_SIGNAL (SIGCHLD);
#endif /* HAVE_GRANTPT || HAVE_UNLOCKPT */
fcntl(master_fd, F_SETFL, O_NONBLOCK);
return s48_cons(s48_enter_fixnum(master_fd), scm_slave_name);
}
static int
allocate_master(const char ** slave_name, const char** clone){
int master_fd = -1;
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)
return master_fd;
#endif /* HAVE_GETPT */
#if defined(HAVE_OPENPTY) /* BSD, Tru64, glibc */
{
int slave_fd = -1;
int rc;
BLOCK_SIGNAL (SIGCHLD);
rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
UNBLOCK_SIGNAL (SIGCHLD);
if (rc == 0)
{
*slave_name = ttyname (slave_fd);
retry_close (slave_fd);
return master_fd;
}
else
{
if (master_fd >= 0)
retry_close (master_fd);
if (slave_fd >= 0)
retry_close (slave_fd);
}
}
#endif /* HAVE_OPENPTY */
#if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */
master_fd = -1;
BLOCK_SIGNAL (SIGCHLD);
*slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0);
UNBLOCK_SIGNAL (SIGCHLD);
if (master_fd >= 0 && *slave_name != NULL)
return master_fd;
#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 ((char *) *clone, // TODO: retry open
O_RDWR | O_NONBLOCK, 0);
if (master_fd >= 0)
return master_fd;
}
*clone = NULL;
}
return -1;
}
static const char*
allocate_slave_name(int master_fd, const char* clone){
char * slave_name;
#if defined (HAVE_PTSNAME)
slave_name = ptsname (master_fd);
if (slave_name)
return slave_name;
#endif
/* kludge for AIX */
if (clone
&& !strcmp (clone, "/dev/ptc")
&& (slave_name = ttyname (master_fd)) != NULL)
return slave_name;
return NULL;
}
void s48_init_tty(void)
{
S48_EXPORT_FUNCTION(scheme_tcgetattr);
@ -242,7 +509,9 @@ void s48_init_tty(void)
S48_EXPORT_FUNCTION(sch_tcsetpgrp);
S48_EXPORT_FUNCTION(sch_tcgetpgrp);
S48_EXPORT_FUNCTION(open_ctty);
S48_EXPORT_FUNCTION(make_ctty);
S48_EXPORT_FUNCTION(sch_isatty);
S48_EXPORT_FUNCTION(sch_ttyname);
S48_EXPORT_FUNCTION(scm_ctermid);
S48_EXPORT_FUNCTION(allocate_pty);
}