Skip to content

Commit a8666cc

Browse files
hasufellhasufell
committed
f AFPP
1 parent 5ed5141 commit a8666cc

File tree

4 files changed

+212
-3
lines changed

4 files changed

+212
-3
lines changed

‎System/Posix/IO/PosixString.hsc

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ module System.Posix.IO.PosixString (
2626
-- ** Opening and closing files
2727
OpenMode(..),
2828
OpenFileFlags(..), defaultFileFlags,
29-
openFd, createFile,
29+
openFd, openFdAt, createFile, createFileAt,
3030
closeFd,
3131

3232
-- ** Reading\/writing data

‎System/Posix/Signals.hsc

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -101,21 +101,21 @@ import Foreign.ForeignPtr
101101
import Foreign.Marshal
102102
import Foreign.Ptr
103103
import Foreign.Storable
104+
import System.IO.Error ( ioeSetLocation )
104105
import System.IO.Unsafe (unsafePerformIO)
105106
import System.Posix.Types
106107
import System.Posix.Internals
107108
import System.Posix.Process
108109
import System.Posix.Process.Internals
109110
import Data.Dynamic
111+
import GHC.IO.Exception ( unsupportedOperation )
110112

111113
##include "rts/Signals.h"
112114

113115
import GHC.Conc hiding (Signal)
114116

115117
#if !defined(HAVE_SIGNAL_H)
116118
import Control.Exception ( throw )
117-
import System.IO.Error ( ioeSetLocation )
118-
import GHC.IO.Exception ( unsupportedOperation )
119119
#endif
120120

121121
-- -----------------------------------------------------------------------------

‎System/Posix/Terminal/PosixString.hsc

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

‎unix.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -127,6 +127,7 @@ library
127127

128128
System.Posix.Terminal
129129
System.Posix.Terminal.ByteString
130+
System.Posix.Terminal.PosixString
130131

131132
other-modules:
132133
System.Posix.Directory.Common

0 commit comments

Comments
 (0)