summaryrefslogtreecommitdiffhomepage
path: root/Pty.hs
blob: 92ff4e223d2c0ca53337b275e56fc51550a162f3 (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
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