teideal glic deisbhéalach

Some time around the GHC 6.6.1 era, I added pty support to the standard Haskell unix package. It's very basic in form, and I've been sitting for a long time on another patch to round it out.

The basic pty interface is as follows:

openPseudoTerminal :: IO (Fd, Fd)

This gives you back two file descriptors: the first is for the master side of the pty, the second for the slave. As a programming interface, this really isn't up to snuff, since nobody wants to be monkeying around directly with file descriptors in this day and age.

Here's a standalone implementation of the higher-level API that I intend to add, as soon as I get the chance. This is still far from an expect-like API, but it's an important step in that direction, and it gets rid of a lot of low-level nonsense. This code compiles only with GHC 6.8.1 or newer.

{-# LANGUAGE ForeignFunctionInterface #-}

module UsefulPty
    (
    prepareForLogin,
    forkPseudoTerminal,
    executePseudoTerminal,
    executePseudoTerminalFd
    ) where

import Control.Monad (when)
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types (CInt)
import System.IO (Handle, IOMode(..))
import System.Posix.IO ( closeFd, dupTo, stdInput, stdOutput, stdError )
import System.Posix.Process (createSession, executeFile, forkProcess)
import System.Posix.Terminal (getTerminalName, openPseudoTerminal)
import System.Posix.Types (Fd(..), ProcessID)
import GHC.Handle (fdToHandle')

-- | Prepare a slave pty for login.  A new session is started and
-- established as the controlling tty, and the given file descriptor
-- is set up as stdin, stdout, and stderr.
prepareForLogin :: Fd -> IO ()
prepareForLogin fd = do
  createSession
  throwErrnoIfMinus1_ "prepareForLogin" (c_setctty fd)
  dupTo fd stdInput
  dupTo fd stdOutput
  dupTo fd stdError
  when (fd > stdError) $
    closeFd fd

foreign import ccall unsafe "__pty_setctty"
  c_setctty :: Fd -> IO CInt

-- | Fork a process, with parent and child connected to master and
-- slave sides of a pty.  The given action is executed on the child
-- side, after executing 'prepareForLogin'.  On the parent side, the
-- pty master and child's process ID are returned.
forkPseudoTerminal :: IO () -> IO (Fd, ProcessID)
forkPseudoTerminal child = do
    (master, slave) <- openPseudoTerminal
    pid <- forkProcess $ do
        prepareForLogin slave
        closeFd master
        child
    closeFd slave
    return (master, pid)

-- | Execute a child process under the control of a pty.  The pty
-- master and child's process ID are returned.
executePseudoTerminalFd :: FilePath  -- ^ Command
                        -> Bool   -- ^ Search for command in PATH?
                        -> [String]  -- ^ Arguments
                        -> Maybe [(String, String)]  -- ^ Environment
                        -> IO (Fd, ProcessID)
executePseudoTerminalFd path search args env =
    forkPseudoTerminal (executeFile path search args env)

-- | Execute a child process under the control of a pty.  The pty
-- master (as a file handle) and child's process ID are returned.
executePseudoTerminal :: FilePath  -- ^ Command
                        -> Bool   -- ^ Search PATH?
                        -> [String]  -- ^ Arguments
                        -> Maybe [(String, String)]  -- ^ Environment
                        -> IO (Handle, ProcessID)
executePseudoTerminal path search args env = do
    (fd@(Fd fd'), pid) <- forkPseudoTerminal (executeFile path search args env)
    name <- getTerminalName fd                 
    h <- fdToHandle' (fromIntegral fd') Nothing False name ReadWriteMode True
    return (h, pid)

The Haskell code depends on one C-level function:

#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <stdlib.h>
#include <unistd.h>

int __pty_setctty(int fd)
{
#ifdef TIOCSCTTY
    if (ioctl(fd, TIOCSCTTY, NULL) == -1)
        return -1;
#else
    // If we don't have TIOCSCTTY, we should be able to replace the
    // current controlling terminal by detaching from it and opening
    // the named terminal again.  This open should cause the terminal
    // to become our controlling terminal.

    char *name = ttyname(fd);
    int nfd;
    if (name == NULL)
        return -1;

    if (fd != STDIN_FILENO)
        close(STDIN_FILENO);
    if (fd != STDOUT_FILENO)
        close(STDOUT_FILENO);
    if (fd != STDERR_FILENO)
        close(STDERR_FILENO);
    nfd = open(name, O_RDWR);
    if (nfd >= 0)
        close(nfd);
#endif
    return 0;
}

In a followup posting, I'll show how to use these improved APIs to interact with another Unix process through a pty.