Running vi from within haskell program (dealing with ptys)

Viewed 378

I'm trying to write a logging shell; e.g. one that captures data about commands that are being run in a structured format. To do this, I'm using readline to read in commands and then executing them in a subshell whilst capturing things such as the time taken, the environment, the exit status and so on.

So far so good. However, initial attempts to run things such as vi or less from within this logging shell failed. Investigation suggested that the thing to do was to establish a pseudo-tty and connect the subshell to that rather than to a normal pipe. This stops vi complaining about not being connected to a terminal, but still fails - I get some nonsense printed to the screen and commands print as characters in the editor - e.g. 'ESC' just displays ^[.

I thought that what I needed to do was put the pty in raw mode. To do this, I tried the following:

  pty <- do
    parentTerminal <- getControllingTerminalName >>= 
                      \a -> openFd a ReadWrite Nothing defaultFileFlags
    sttyp <- getTerminalAttributes parentTerminal
    (a, b) <- openPseudoTerminal
    let rawModes = [ProcessInput, KeyboardInterrupts, ExtendedFunctions, 
                    EnableEcho, InterruptOnBreak, MapCRtoLF, IgnoreBreak, 
                    IgnoreCR, MapLFtoCR, CheckParity, StripHighBit, 
                    StartStopOutput, MarkParityErrors, ProcessOutput]
        sttym = withoutModes rawModes sttyp
        withoutModes modes tty = foldl withoutMode tty modes
    setTerminalAttributes b sttym Immediately
    setTerminalAttributes a sttym Immediately
    a' <- fdToHandle a
    b' <- fdToHandle b
    return (a',b')

E.g. we get the parent terminal's attributes, remove the various flags that I think correspond to setting the tty into raw mode (based on this code and the haddock for System.Posix.Terminal), and then set these on both sides of the pty.

I then start up a process within a shell using createProcess and use waitForProcess to connect to it, giving the slave side of the pty for the stdin and stdout handles on the child process:

eval :: (Handle, Handle) -> String -> IO ()
eval pty command = do
    let (ptym, ptys) = pty
    (_, _, hErr, ph) <- createProcess $ (shell command) { 
          delegate_ctlc = True
        , std_err = CreatePipe
        , std_out = UseHandle ptys
        , std_in = UseHandle ptys
      }
    snipOut <- tee ptym stdout
    snipErr <- sequence $ fmap (\h -> tee h stderr) hErr
    exitCode <- waitForProcess ph
    return ()
  where tee :: Handle -> Handle -> IO B.ByteString
        tee from to = DCB.sourceHandle from
            $= DCB.conduitHandle to -- Sink contents to out Handle
            $$ DCB.take 256 -- Pull off the start of the stream

This definitely changes terminal settings (confirmed with stty), but doesn't fix the problem. Am I missing something? Is there some other device I need to set attributes on?

Edit: The full runnable code is available at https://github.com/nc6/tabula - I've simplified a few things for this post.

2 Answers
Related