diff --git a/configure.in b/configure.in index f412029..0fe6bc2 100644 --- a/configure.in +++ b/configure.in @@ -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} diff --git a/scsh/pty.scm b/scsh/pty.scm index 9b78657..36a2ee6 100644 --- a/scsh/pty.scm +++ b/scsh/pty.scm @@ -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. diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 590fe97..e8e981c 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -1038,6 +1038,7 @@ decode-baud-rate open-control-tty + make-control-tty set-tty-process-group tty-process-group diff --git a/scsh/tty.scm b/scsh/tty.scm index 1fc2684..d10468d 100644 --- a/scsh/tty.scm +++ b/scsh/tty.scm @@ -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 diff --git a/scsh/tty1.c b/scsh/tty1.c index aaf16a8..f2e203b 100644 --- a/scsh/tty1.c +++ b/scsh/tty1.c @@ -10,15 +10,63 @@ * Copyright (c) 1995 by Brian D. Carlstrom * Re-written by Olin. */ - +#include "sysdep.h" +#include #include #include /* ctermid decl */ #include #include #include #include +#include +#include #include "scheme48.h" +#ifdef HAVE_STROPTS_H +#include +#endif + +#ifdef HAVE_PTY_H +#include /* openpty() on Tru64, Linux */ +#endif + +#ifdef HAVE_LIBUTIL_H +#include /* openpty() on FreeBSD */ +#endif + +#ifdef HAVE_UTIL_H +#include /* 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); }