blob: efdacd2d281dceae68abe8c7e21d0d363b6fe2d0 (
plain)
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
|
module Pty where
import System.Posix.Terminal
import System.Posix
import System.Process
import System.IO
import Control.Exception
data Master a = Master a
data Slave a = Slave a
data Pty = Pty
{ ptyMaster :: Master Handle
, ptySlave :: Slave Handle
}
openPty :: TerminalAttributes -> IO Pty
openPty attrs = do
(master, slave) <- openPseudoTerminal
setTerminalAttributes slave attrs Immediately
hmaster <- fdToHandle master
hslave <- fdToHandle slave
return $ Pty (Master hmaster) (Slave hslave)
-- | Make a CreateProcess run on a Pty.
onPty :: Pty -> CreateProcess -> CreateProcess
onPty (Pty _ (Slave slave)) p = p
{ std_in = UseHandle slave
, std_out = UseHandle slave
, std_err = UseHandle slave
, close_fds = True
-- New session makes job control work in bash, etc.
, new_session = True
, create_group = True
-- ctrl-c should be sent to the process for handling.
, delegate_ctlc = True
}
-- | Runs an action with a child pty opened. 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).
withChildPty :: (Pty -> IO a) -> IO a
withChildPty a = bracket setup cleanup go
where
setup = do
as <- getTerminalAttributes stdInput
-- 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 as
cleanup as = setTerminalAttributes stdInput as Immediately
go as = do
p <- openPty as
a p
|
