Move openPseudoTerminal into System.Posix.Terminal{.ByteString}
[packages/unix.git] / System / Posix / Terminal.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
3 #if __GLASGOW_HASKELL__ >= 701
4 {-# LANGUAGE Trustworthy #-}
5 #endif
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module      :  System.Posix.Terminal
9 -- Copyright   :  (c) The University of Glasgow 2002
10 -- License     :  BSD-style (see the file libraries/base/LICENSE)
11 -- 
12 -- Maintainer  :  libraries@haskell.org
13 -- Stability   :  provisional
14 -- Portability :  non-portable (requires POSIX)
15 --
16 -- POSIX Terminal support
17 --
18 -----------------------------------------------------------------------------
19
20 module System.Posix.Terminal (
21   -- * Terminal support
22
23   -- ** Terminal attributes
24   TerminalAttributes,
25   getTerminalAttributes,
26   TerminalState(..),
27   setTerminalAttributes,
28
29   TerminalMode(..),
30   withoutMode,
31   withMode,
32   terminalMode,
33   bitsPerByte,
34   withBits,
35
36   ControlCharacter(..),
37   controlChar,
38   withCC,
39   withoutCC,
40
41   inputTime,
42   withTime,
43   minInput,
44   withMinInput,
45
46   BaudRate(..),
47   inputSpeed,
48   withInputSpeed,
49   outputSpeed,
50   withOutputSpeed,
51
52   -- ** Terminal operations
53   sendBreak,
54   drainOutput,
55   QueueSelector(..),
56   discardData,
57   FlowAction(..),
58   controlFlow,
59
60   -- ** Process groups
61   getTerminalProcessGroupID,
62   setTerminalProcessGroupID,
63
64   -- ** Testing a file descriptor
65   queryTerminal,
66   getTerminalName,
67   getControllingTerminalName,
68
69   -- ** Pseudoterminal operations
70   openPseudoTerminal,
71   getSlaveTerminalName
72   ) where
73
74 #include "HsUnix.h"
75
76 import Foreign
77 import Foreign.C
78 import System.Posix.Terminal.Common
79 import System.Posix.Types
80
81 #if __GLASGOW_HASKELL__ > 700
82 import System.Posix.Internals (withFilePath, peekFilePath)
83 #elif __GLASGOW_HASKELL__ > 611
84 import System.Posix.Internals (withFilePath)
85
86 peekFilePath :: CString -> IO FilePath
87 peekFilePath = peekCString
88
89 peekFilePathLen :: CStringLen -> IO FilePath
90 peekFilePathLen = peekCStringLen
91 #else
92 withFilePath :: FilePath -> (CString -> IO a) -> IO a
93 withFilePath = withCString
94
95 peekFilePath :: CString -> IO FilePath
96 peekFilePath = peekCString
97
98 peekFilePathLen :: CStringLen -> IO FilePath
99 peekFilePathLen = peekCStringLen
100 #endif
101
102 -- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
103 --   with the terminal for @Fd@ @fd@. If @fd@ is associated
104 --   with a terminal, @getTerminalName@ returns the name of the
105 --   terminal.
106 getTerminalName :: Fd -> IO FilePath
107 getTerminalName (Fd fd) = do
108   s <- throwErrnoIfNull "getTerminalName" (c_ttyname fd)
109   peekFilePath s  
110
111 foreign import ccall unsafe "ttyname"
112   c_ttyname :: CInt -> IO CString
113
114 -- | @getControllingTerminalName@ calls @ctermid@ to obtain
115 --   a name associated with the controlling terminal for the process.  If a
116 --   controlling terminal exists,
117 --   @getControllingTerminalName@ returns the name of the
118 --   controlling terminal.
119 getControllingTerminalName :: IO FilePath
120 getControllingTerminalName = do
121   s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
122   peekFilePath s
123
124 foreign import ccall unsafe "ctermid"
125   c_ctermid :: CString -> IO CString
126
127 -- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
128 -- slave terminal associated with a pseudoterminal pair.  The file
129 -- descriptor to pass in must be that of the master.
130 getSlaveTerminalName :: Fd -> IO FilePath
131
132 #ifdef HAVE_PTSNAME
133 getSlaveTerminalName (Fd fd) = do
134   s <- throwErrnoIfNull "getSlaveTerminalName" (c_ptsname fd)
135   peekFilePath s
136
137 foreign import ccall unsafe "__hsunix_ptsname"
138   c_ptsname :: CInt -> IO CString
139 #else
140 getSlaveTerminalName _ =
141     ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
142 #endif
143
144 -- -----------------------------------------------------------------------------
145 -- openPseudoTerminal needs to be here because it depends on
146 -- getSlaveTerminalName.
147
148 -- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
149 -- returns the newly created pair as a (@master@, @slave@) tuple.
150 openPseudoTerminal :: IO (Fd, Fd)
151
152 #ifdef HAVE_OPENPTY
153 openPseudoTerminal =
154   alloca $ \p_master ->
155     alloca $ \p_slave -> do
156       throwErrnoIfMinus1_ "openPty"
157           (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
158       master <- peek p_master
159       slave <- peek p_slave
160       return (Fd master, Fd slave)
161
162 foreign import ccall unsafe "openpty"
163   c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
164             -> IO CInt
165 #else
166 openPseudoTerminal = do
167   (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
168                         defaultFileFlags{noctty=True}
169   throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
170   throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
171   slaveName <- getSlaveTerminalName (Fd master)
172   slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
173   pushModule slave "ptem"
174   pushModule slave "ldterm"
175 # ifndef __hpux
176   pushModule slave "ttcompat"
177 # endif /* __hpux */
178   return (Fd master, slave)
179
180 -- Push a STREAMS module, for System V systems.
181 pushModule :: Fd -> String -> IO ()
182 pushModule (Fd fd) name =
183   withCString name $ \p_name ->
184     throwErrnoIfMinus1_ "openPseudoTerminal"
185                         (c_push_module fd p_name)
186
187 foreign import ccall unsafe "__hsunix_push_module"
188   c_push_module :: CInt -> CString -> IO CInt
189
190 #ifdef HAVE_PTSNAME
191 foreign import ccall unsafe "__hsunix_grantpt"
192   c_grantpt :: CInt -> IO CInt
193
194 foreign import ccall unsafe "__hsunix_unlockpt"
195   c_unlockpt :: CInt -> IO CInt
196 #else
197 c_grantpt :: CInt -> IO CInt
198 c_grantpt _ = return (fromIntegral 0)
199
200 c_unlockpt :: CInt -> IO CInt
201 c_unlockpt _ = return (fromIntegral 0)
202 #endif /* HAVE_PTSNAME */
203 #endif /* !HAVE_OPENPTY */
204