static s48_ref_t posix_pipe(s48_call_t call) { int fildes[2], status; s48_ref_t in_channel, out_channel; s48_ref_t id = s48_enter_string_latin_1_2 (call, "pipe"); RETRY_OR_RAISE_NEG(status, pipe(fildes)); in_channel = s48_add_channel_2(call, s48_channel_status_input_2(call), id, fildes[0]); if (!s48_channel_p_2(call, in_channel)) { ps_close_fd(fildes[0]); /* retries if interrupted */ ps_close_fd(fildes[1]); /* retries if interrupted */ s48_raise_scheme_exception_2(call, s48_extract_long_2(call, in_channel), 0); } RETRY_OR_RAISE_NEG(status, fcntl(fildes[1], F_SETFL, O_NONBLOCK)); out_channel = s48_add_channel_2(call, s48_channel_status_output_2(call), id, fildes[1]); if (!s48_channel_p_2(call, out_channel)) { s48_close_channel(fildes[0]); ps_close_fd(fildes[1]); /* retries if interrupted */ s48_raise_scheme_exception_2(call, s48_extract_long_2(call, in_channel), 0); } return s48_cons_2(call, in_channel, out_channel); }
s48_ref_t scheme_tcgetattr(s48_call_t call, s48_ref_t sch_fd, s48_ref_t sch_control_chars) { struct termios t; int fd = s48_extract_long_2(call, sch_fd); int i; int result; s48_ref_t sch_iflag = s48_unspecific_2(call); s48_ref_t sch_oflag = s48_unspecific_2(call); s48_ref_t sch_cflag = s48_unspecific_2(call); s48_ref_t sch_lflag = s48_unspecific_2(call); s48_ref_t sch_ispeed = s48_unspecific_2(call); s48_ref_t sch_ospeed = s48_unspecific_2(call); s48_ref_t sch_retval = s48_unspecific_2(call); if (isatty(fd) == 0) { fprintf(stderr, "%d is not a tty\n", fd); return s48_false_2(call); } result = tcgetattr(s48_extract_long_2(call, sch_fd), &t); if (result == -1) { s48_os_error_2(call, "scheme_tcgetattr", errno, 2, sch_fd, sch_control_chars); } for (i = 0; i < NCCS; i++) s48_string_set_2(call, sch_control_chars, i, t.c_cc[i]); { sch_iflag = s48_enter_long_2(call, t.c_iflag); sch_oflag = s48_enter_long_2(call, t.c_oflag); sch_cflag = s48_enter_long_2(call, t.c_cflag); sch_lflag = s48_enter_long_2(call, t.c_lflag); sch_ispeed = s48_enter_long_2(call, cfgetispeed(&t)); sch_ospeed = s48_enter_long_2(call, cfgetospeed(&t)); sch_retval = s48_cons_2(call, sch_ospeed, s48_null_2(call)); sch_retval = s48_cons_2(call, sch_ispeed, sch_retval); sch_retval = s48_cons_2(call, sch_lflag, sch_retval); sch_retval = s48_cons_2(call, sch_cflag, sch_retval); sch_retval = s48_cons_2(call, sch_oflag, sch_retval); sch_retval = s48_cons_2(call, sch_iflag, sch_retval); return sch_retval; } }
/* Open an available pty, returning a file descriptor. Return -1 on failure. */ s48_ref_t allocate_pty(s48_call_t call) { /* 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; int off = 0; s48_ref_t scm_slave_name = s48_unspecific_2(call); master_fd = allocate_master(&slave_name, &clone); if (master_fd == -1) return s48_false_2(call); if (slave_name == NULL){ slave_name = allocate_slave_name(master_fd, clone); if (slave_name == NULL){ retry_close (master_fd); return s48_false_2(call); } } scm_slave_name = s48_enter_byte_string_2(call, (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, [email protected]), but apparently it messed up rlogind and telnetd, so he removed the fix in pre2.0.14. - [email protected] */ 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_2(call, s48_enter_long_2(call, master_fd), scm_slave_name); }