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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Pty (
Pty,
runWithPty,
readPty,
writePty,
inRawMode,
withoutEcho,
withTerminalAttributes,
) where
import System.Posix
import System.Posix.Pty
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 <- System.Posix.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
-- Set the pty's terminal attributes to the same ones that
-- the outer terminal had.
System.Posix.Pty.setTerminalAttributes p as Immediately
System.Posix.setTerminalAttributes stdInput (setRawMode as) 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
System.Posix.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)
withTerminalAttributes :: (TerminalAttributes -> TerminalAttributes) -> IO a -> IO a
withTerminalAttributes f a = bracket setup cleanup go
where
setup = do
as <- System.Posix.getTerminalAttributes stdInput
System.Posix.setTerminalAttributes stdInput (f as) Immediately
return as
cleanup as = System.Posix.setTerminalAttributes stdInput as Immediately
go _ = a
-- | This is similar to cfmakeraw(3).
inRawMode :: IO a -> IO a
inRawMode = withTerminalAttributes setRawMode
setRawMode :: TerminalAttributes -> TerminalAttributes
setRawMode as = 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
-- | Disable terminal echo.
withoutEcho :: IO a -> IO a
withoutEcho = withTerminalAttributes $ \as -> as
`withoutMode` EnableEcho
|
