1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
module Pty (Pty, runWithPty, readPty, writePty) where
import System.Posix
import System.Posix.Pty hiding (setTerminalAttributes, getTerminalAttributes)
import qualified System.Console.Terminal.Size as Console
import System.Posix.Signals.Exts
import System.Process
import Control.Exception
-- | Run a program on a Pty.
--
-- While doing so, the outer pty has echo disabled (so the child can echo),
-- and has raw mode enabled (so the child pty can see all special characters).
--
-- A SIGWINCH handler is installed, to forward resizes to the Pty.
runWithPty :: String -> [String] -> ((Pty, ProcessHandle) -> IO a) -> IO a
runWithPty cmd params a = bracket setup cleanup go
where
setup = do
as <- getTerminalAttributes stdInput
sz <- Console.size
(p, ph) <- spawnWithPty Nothing True cmd params
(maybe 80 Console.width sz, maybe 25 Console.height sz)
_ <- installHandler windowChange (Catch (forwardresize p)) Nothing
-- This is similar to cfmakeraw(3).
let masteras = as
`withoutMode` IgnoreBreak
`withoutMode` InterruptOnBreak
`withoutMode` CheckParity
`withoutMode` StripHighBit
`withoutMode` MapLFtoCR
`withoutMode` IgnoreCR
`withoutMode` MapCRtoLF
`withoutMode` StartStopOutput
`withoutMode` ProcessOutput
`withoutMode` EnableEcho
`withoutMode` EchoLF
`withoutMode` ProcessInput
`withoutMode` KeyboardInterrupts
`withoutMode` ExtendedFunctions
`withoutMode` EnableParity
setTerminalAttributes stdInput masteras Immediately
return (p, ph, as)
cleanup (p, ph, as) = do
-- Needed in case the provided action throws an exception
-- before it waits for the process.
terminateProcess ph
closePty p
_ <- installHandler windowChange Default Nothing
setTerminalAttributes stdInput as Immediately
go (p, ph, _) = a (p, ph)
forwardresize p = do
msz <- Console.size
case msz of
Nothing -> return ()
Just sz -> resizePty p (Console.width sz, Console.height sz)
|
