/* To do: * - Replace explicit 8/24 splits with macros. * - We need to pass the control-chars vecs in as Scheme * strings, and test the length before doing the memcpy. */ /* * Scheme48/scsh terminal control interface. * Routines that require custom C support. * 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. */ #if defined(TIOCSCTTY) && !defined(CIBAUD) #include #endif #include "tty1.h" /* Make sure the .h interface agrees with the code. */ /*****************************************************************************/ s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars) /* int *iflag, int *oflag, int *cflag, int *lflag, 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; s48_value sch_oflag = S48_UNSPECIFIC; s48_value sch_cflag = S48_UNSPECIFIC; s48_value sch_lflag = S48_UNSPECIFIC; s48_value sch_ispeed = S48_UNSPECIFIC; s48_value sch_ospeed = S48_UNSPECIFIC; s48_value sch_retval = S48_UNSPECIFIC; S48_DECLARE_GC_PROTECT(6); S48_GC_PROTECT_6(sch_iflag, sch_oflag, sch_cflag, sch_lflag, sch_ispeed, sch_ospeed); if (result == -1) { S48_GC_UNPROTECT(); s48_raise_os_error_2 (errno, sch_fd, sch_control_chars); } for (i = 0; i < NCCS; i++) S48_STRING_SET(sch_control_chars, i, t.c_cc[i]); { sch_iflag = s48_enter_integer(t.c_iflag); sch_oflag = s48_enter_integer(t.c_oflag); sch_cflag = s48_enter_integer(t.c_cflag); sch_lflag = s48_enter_integer(t.c_lflag); sch_ispeed = s48_enter_integer(cfgetispeed(&t)); sch_ospeed = s48_enter_integer(cfgetospeed(&t)); sch_retval = s48_list_6 (sch_iflag, sch_oflag, sch_cflag, sch_lflag, sch_ispeed, sch_ospeed); S48_GC_UNPROTECT(); return sch_retval; } } /* The Scheme caller of this is commented out...*/ int scheme_tcgetattrB(int fd, char *control_chars, s48_value scmvec) { struct termios t; int result = tcgetattr(fd, &t); S48_DECLARE_GC_PROTECT(1); S48_GC_PROTECT_1(scmvec); /* JMG int *ivec = ADDRESS_AFTER_HEADER(scmvec, int);*/ if (result != -1) { memcpy(control_chars, t.c_cc, NCCS); S48_VECTOR_SET(scmvec, 0, s48_enter_integer(t.c_iflag)); S48_VECTOR_SET(scmvec, 1, s48_enter_integer(t.c_oflag)); S48_VECTOR_SET(scmvec, 2, s48_enter_integer(t.c_cflag)); S48_VECTOR_SET(scmvec, 3, s48_enter_integer(t.c_lflag)); S48_VECTOR_SET(scmvec, 4, s48_enter_fixnum(cfgetispeed(&t))); S48_VECTOR_SET(scmvec, 5, s48_enter_fixnum(cfgetospeed(&t))); } S48_GC_UNPROTECT(); return result; } /*****************************************************************************/ s48_value scheme_tcsetattr(s48_value sch_fd, s48_value sch_option, s48_value sch_control_chars, s48_value sch_iflag, s48_value sch_oflag, s48_value sch_cflag, s48_value sch_lflag, s48_value sch_ispeed, s48_value sch_ospeed, s48_value sch_min, s48_value sch_time) { struct termios t; memcpy(t.c_cc, s48_extract_string (sch_control_chars), NCCS); /* This first clause of this conditional test will hopefully ** resolve the branch at compile time. However, since VMIN/VEOF ** and VTIME/VEOL are allowed by POSIX to colllide, we have to check. ** If they do collide, we set EOF & EOL in canonical mode, and MIN & TIME ** in raw mode. Ah, Unix. */ t.c_iflag = s48_extract_integer (sch_iflag); t.c_oflag = s48_extract_integer (sch_oflag); t.c_cflag = s48_extract_integer (sch_cflag); t.c_lflag = s48_extract_integer (sch_lflag); if( (VMIN != VEOF && VTIME != VEOL) || !(t.c_lflag & ICANON) ) { t.c_cc[VMIN] = s48_extract_fixnum (sch_min); t.c_cc[VTIME] = s48_extract_integer (sch_time); } cfsetispeed(&t, s48_extract_integer (sch_ispeed)); cfsetospeed(&t, s48_extract_integer (sch_ospeed)); if (tcsetattr(s48_extract_fixnum (sch_fd), s48_extract_integer (sch_option), &t) == -1) s48_raise_os_error_1 (errno, sch_fd); return S48_UNSPECIFIC; } s48_value sch_tcsendbreak (s48_value sch_fd, s48_value sch_duration) { if (tcsendbreak (s48_extract_fixnum (sch_fd), s48_extract_integer (sch_duration)) == -1) s48_raise_os_error_2 (errno, sch_fd, sch_duration); return S48_UNSPECIFIC; } s48_value sch_tcdrain (s48_value sch_fd) { if (tcdrain (s48_extract_fixnum (sch_fd)) == -1) s48_raise_os_error_1 (errno, sch_fd); return S48_UNSPECIFIC; } s48_value sch_tcflush (s48_value sch_fd, s48_value sch_action) { if (tcflush (s48_extract_fixnum (sch_fd), s48_extract_fixnum (sch_action)) == -1) s48_raise_os_error_2 (errno, sch_fd, sch_action); return S48_UNSPECIFIC; } s48_value sch_tcflow (s48_value sch_fd, s48_value sch_action) { if (tcflow (s48_extract_fixnum (sch_fd), s48_extract_fixnum (sch_action)) == -1) s48_raise_os_error_2 (errno, sch_fd, sch_action); return S48_UNSPECIFIC; } s48_value sch_tcsetpgrp (s48_value sch_fd, s48_value sch_pid) { if (tcsetpgrp (s48_extract_fixnum (sch_fd), s48_extract_fixnum (sch_pid)) == -1) s48_raise_os_error_2 (errno, sch_fd, sch_pid); return S48_UNSPECIFIC; } s48_value sch_tcgetpgrp (s48_value sch_fd) { int ret = tcgetpgrp (s48_extract_fixnum (sch_fd)); if (ret == -1) s48_raise_os_error_1 (errno, sch_fd); return s48_enter_integer (ret); } /*****************************************************************************/ s48_value open_ctty(s48_value sch_ttyname, s48_value sch_flags) { int fd = open(s48_extract_string (sch_ttyname), s48_extract_integer (sch_flags)); #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) ) { int e = errno; close(fd); s48_raise_os_error_2 (e, sch_ttyname, sch_flags); } #endif if (fd == -1) s48_raise_os_error_2 (errno, sch_ttyname, 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); } s48_value sch_ttyname (s48_value sch_fd) { char* ret = ttyname (s48_extract_fixnum (sch_fd)); if (ret == NULL) s48_raise_os_error_1 (errno, sch_fd); return s48_enter_string (ret); } s48_value scm_ctermid() { char* ret = ctermid(0); if (ret == NULL) s48_raise_os_error (errno); 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); S48_EXPORT_FUNCTION(scheme_tcsetattr); S48_EXPORT_FUNCTION(sch_tcsendbreak); S48_EXPORT_FUNCTION(sch_tcdrain); S48_EXPORT_FUNCTION(sch_tcflush); S48_EXPORT_FUNCTION(sch_tcflow); 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); }