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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
{-# LANGUAGE CApiFFI #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Posix.Terminal
-- Copyright : (c) The University of Glasgow 2002
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
-- Portability : non-portable (requires POSIX)
--
-- POSIX Terminal support
--
-----------------------------------------------------------------------------
module System.Posix.Terminal (
-- * Terminal support
-- ** Terminal attributes
TerminalAttributes,
getTerminalAttributes,
TerminalState(..),
setTerminalAttributes,
TerminalMode(..),
withoutMode,
withMode,
terminalMode,
bitsPerByte,
withBits,
ControlCharacter(..),
controlChar,
withCC,
withoutCC,
inputTime,
withTime,
minInput,
withMinInput,
BaudRate(..),
inputSpeed,
withInputSpeed,
outputSpeed,
withOutputSpeed,
-- ** Terminal operations
sendBreak,
drainOutput,
QueueSelector(..),
discardData,
FlowAction(..),
controlFlow,
-- ** Process groups
getTerminalProcessGroupID,
setTerminalProcessGroupID,
-- ** Testing a file descriptor
queryTerminal,
getTerminalName,
getControllingTerminalName,
-- ** Pseudoterminal operations
openPseudoTerminal,
getSlaveTerminalName
) where
#include "HsUnix.h"
import Foreign
import Foreign.C
import System.Posix.Terminal.Common
import System.Posix.Types
#ifndef HAVE_OPENPTY
import System.Posix.IO
#endif
import System.Posix.Internals (peekFilePath)
#if !HAVE_CTERMID
import System.IO.Error ( ioeSetLocation )
import GHC.IO.Exception ( unsupportedOperation )
#endif
-- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
-- with the terminal for @Fd@ @fd@. If @fd@ is associated
-- with a terminal, @getTerminalName@ returns the name of the
-- terminal.
getTerminalName :: Fd -> IO FilePath
getTerminalName (Fd fd) = do
s <- throwErrnoIfNull "getTerminalName" (c_ttyname fd)
peekFilePath s
foreign import ccall unsafe "ttyname"
c_ttyname :: CInt -> IO CString
-- | @getControllingTerminalName@ calls @ctermid@ to obtain
-- a name associated with the controlling terminal for the process. If a
-- controlling terminal exists,
-- @getControllingTerminalName@ returns the name of the
-- controlling terminal.
--
-- Throws 'IOError' (\"unsupported operation\") if platform does not
-- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to
-- detect availability).
getControllingTerminalName :: IO FilePath
#if HAVE_CTERMID
getControllingTerminalName = do
s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
peekFilePath s
foreign import capi unsafe "termios.h ctermid"
c_ctermid :: CString -> IO CString
#else
{-# WARNING getControllingTerminalName
"operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-}
getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName")
#endif
-- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
-- slave terminal associated with a pseudoterminal pair. The file
-- descriptor to pass in must be that of the master.
getSlaveTerminalName :: Fd -> IO FilePath
#ifdef HAVE_PTSNAME
getSlaveTerminalName (Fd fd) = do
s <- throwErrnoIfNull "getSlaveTerminalName" (c_ptsname fd)
peekFilePath s
# if __GLASGOW_HASKELL__ < 800
-- see comment in cbits/HsUnix.c
foreign import ccall unsafe "__hsunix_ptsname"
c_ptsname :: CInt -> IO CString
# else
foreign import capi unsafe "HsUnix.h ptsname"
c_ptsname :: CInt -> IO CString
# endif
#else
getSlaveTerminalName _ =
ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
#endif
-- -----------------------------------------------------------------------------
-- openPseudoTerminal needs to be here because it depends on
-- getSlaveTerminalName.
-- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
-- returns the newly created pair as a (@master@, @slave@) tuple.
openPseudoTerminal :: IO (Fd, Fd)
#ifdef HAVE_OPENPTY
openPseudoTerminal =
alloca $ \p_master ->
alloca $ \p_slave -> do
throwErrnoIfMinus1_ "openPty"
(c_openpty p_master p_slave nullPtr nullPtr nullPtr)
master <- peek p_master
slave <- peek p_slave
return (Fd master, Fd slave)
foreign import ccall unsafe "openpty"
c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
-> IO CInt
#else
openPseudoTerminal = do
(Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
defaultFileFlags{noctty=True}
throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
slaveName <- getSlaveTerminalName (Fd master)
slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
pushModule slave "ptem"
pushModule slave "ldterm"
# ifndef __hpux
pushModule slave "ttcompat"
# endif /* __hpux */
return (Fd master, slave)
-- Push a STREAMS module, for System V systems.
pushModule :: Fd -> String -> IO ()
pushModule (Fd fd) name =
withCString name $ \p_name ->
throwErrnoIfMinus1_ "openPseudoTerminal"
(c_push_module fd p_name)
foreign import ccall unsafe "__hsunix_push_module"
c_push_module :: CInt -> CString -> IO CInt
#ifdef HAVE_PTSNAME
# if __GLASGOW_HASKELL__ < 800
-- see comment in cbits/HsUnix.c
foreign import ccall unsafe "__hsunix_grantpt"
c_grantpt :: CInt -> IO CInt
foreign import ccall unsafe "__hsunix_unlockpt"
c_unlockpt :: CInt -> IO CInt
# else
foreign import capi unsafe "HsUnix.h grantpt"
c_grantpt :: CInt -> IO CInt
foreign import capi unsafe "HsUnix.h unlockpt"
c_unlockpt :: CInt -> IO CInt
# endif
#else
c_grantpt :: CInt -> IO CInt
c_grantpt _ = return (fromIntegral 0)
c_unlockpt :: CInt -> IO CInt
c_unlockpt _ = return (fromIntegral 0)
#endif /* HAVE_PTSNAME */
#endif /* !HAVE_OPENPTY */
|
