| Copyright | (C) 2013 Merijn Verstraaten |
|---|---|
| License | BSD-style (see the file LICENSE) |
| Maintainer | Merijn Verstraaten <merijn@inconsistent.nl> |
| Stability | experimental |
| Portability | haha |
| Safe Haskell | Trustworthy |
| Language | Haskell2010 |
System.Posix.Pty
Description
A module for interacting with subprocesses through a pseudo terminal (pty).
Provides functions for reading from, writing to and resizing pseudo
terminals. Re-exports most of System.Posix.Terminal, providing wrappers
that work with the Pty type where necessary.
Synopsis
- spawnWithPty :: Maybe [(String, String)] -> Bool -> FilePath -> [String] -> (Int, Int) -> IO (Pty, ProcessHandle)
- data Pty
- data PtyControlCode
- createPty :: Fd -> IO (Maybe Pty)
- closePty :: Pty -> IO ()
- tryReadPty :: Pty -> IO (Either [PtyControlCode] ByteString)
- readPty :: Pty -> IO ByteString
- writePty :: Pty -> ByteString -> IO ()
- resizePty :: Pty -> (Int, Int) -> IO ()
- ptyDimensions :: Pty -> IO (Int, Int)
- threadWaitReadPty :: Pty -> IO ()
- threadWaitWritePty :: Pty -> IO ()
- threadWaitReadPtySTM :: Pty -> IO (STM (), IO ())
- threadWaitWritePtySTM :: Pty -> IO (STM (), IO ())
- getTerminalAttributes :: Pty -> IO TerminalAttributes
- setTerminalAttributes :: Pty -> TerminalAttributes -> TerminalState -> IO ()
- sendBreak :: Pty -> Int -> IO ()
- drainOutput :: Pty -> IO ()
- discardData :: Pty -> QueueSelector -> IO ()
- controlFlow :: Pty -> FlowAction -> IO ()
- getTerminalProcessGroupID :: Pty -> IO ProcessGroupID
- getTerminalName :: Pty -> IO FilePath
- getSlaveTerminalName :: Pty -> IO FilePath
- getControllingTerminalName :: IO FilePath
- withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes
- outputSpeed :: TerminalAttributes -> BaudRate
- withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes
- inputSpeed :: TerminalAttributes -> BaudRate
- withMinInput :: TerminalAttributes -> Int -> TerminalAttributes
- minInput :: TerminalAttributes -> Int
- withTime :: TerminalAttributes -> Int -> TerminalAttributes
- inputTime :: TerminalAttributes -> Int
- withoutCC :: TerminalAttributes -> ControlCharacter -> TerminalAttributes
- withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes
- controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char
- withBits :: TerminalAttributes -> Int -> TerminalAttributes
- bitsPerByte :: TerminalAttributes -> Int
- terminalMode :: TerminalMode -> TerminalAttributes -> Bool
- withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes
- withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes
- data TerminalAttributes
- data TerminalMode
- = InterruptOnBreak
- | MapCRtoLF
- | IgnoreBreak
- | IgnoreCR
- | IgnoreParityErrors
- | MapLFtoCR
- | CheckParity
- | StripHighBit
- | StartStopInput
- | StartStopOutput
- | MarkParityErrors
- | ProcessOutput
- | LocalMode
- | ReadEnable
- | TwoStopBits
- | HangupOnClose
- | EnableParity
- | OddParity
- | EnableEcho
- | EchoErase
- | EchoKill
- | EchoLF
- | ProcessInput
- | ExtendedFunctions
- | KeyboardInterrupts
- | NoFlushOnInterrupt
- | BackgroundWriteInterrupt
- data ControlCharacter
- data BaudRate
- data TerminalState
- data QueueSelector
- data FlowAction
Subprocess Creation
Arguments
| :: Maybe [(String, String)] | Optional environment for the new process. |
| -> Bool | Search for the executable in PATH? |
| -> FilePath | Program's name. |
| -> [String] | Command line arguments for the program. |
| -> (Int, Int) | Initial dimensions for the pseudo terminal. |
| -> IO (Pty, ProcessHandle) |
Create a new process that is connected to the current process through a pseudo terminal. If an environment is specified, then only the specified environment variables will be set. If no environment is specified the process will inherit its environment from the current process. Example:
pty <- spawnWithPty (Just [("SHELL", "tcsh")]) True "ls" ["-l"] (20, 10)This searches the user's PATH for a binary called ls, then runs this
binary with the commandline argument -l in a terminal that is 20
characters wide and 10 characters high. The environment of ls will
contains one variable, SHELL, which will be set to the value "tcsh".
Data Structures
data PtyControlCode Source #
Pseudo terminal control information.
- Terminal read queue
- The terminal read queue contains the data that was written from the master terminal to the slave terminal, which was not read from the slave yet.
- Terminal write queue
- The terminal write queue contains the data that was written from the slave terminal, which was not sent to the master yet.
Constructors
| FlushRead | Terminal read queue was flushed. |
| FlushWrite | Terminal write queue was flushed. |
| OutputStopped | Terminal output was stopped. |
| OutputStarted | Terminal output was restarted. |
| DoStop | Terminal stop and start characters are
|
| NoStop | Terminal stop and start characters are
NOT |
Instances
| Eq PtyControlCode Source # | |
Defined in System.Posix.Pty Methods (==) :: PtyControlCode -> PtyControlCode -> Bool # (/=) :: PtyControlCode -> PtyControlCode -> Bool # | |
| Read PtyControlCode Source # | |
Defined in System.Posix.Pty Methods readsPrec :: Int -> ReadS PtyControlCode # readList :: ReadS [PtyControlCode] # | |
| Show PtyControlCode Source # | |
Defined in System.Posix.Pty Methods showsPrec :: Int -> PtyControlCode -> ShowS # show :: PtyControlCode -> String # showList :: [PtyControlCode] -> ShowS # | |
Pty Interaction Functions
createPty :: Fd -> IO (Maybe Pty) Source #
Produces a Pty if the file descriptor is associated with a terminal and
Nothing if not.
tryReadPty :: Pty -> IO (Either [PtyControlCode] ByteString) Source #
Attempt to read data from a pseudo terminal. Produces either the data read
or a list of PtyControlCodes indicating which control status events that
have happened on the slave terminal.
Throws an IOError of type eofErrorType when the terminal has been
closed, for example when the subprocess has terminated.
readPty :: Pty -> IO ByteString Source #
The same as tryReadPty, but discards any control status events.
writePty :: Pty -> ByteString -> IO () Source #
Write a ByteString to the pseudo terminal, throws an IOError when the
terminal has been closed, for example when the subprocess has terminated.
resizePty :: Pty -> (Int, Int) -> IO () Source #
Set the pseudo terminal's dimensions to the specified width and height.
Blocking on Ptys
threadWaitReadPty :: Pty -> IO () Source #
Equivalent to threadWaitRead.
threadWaitWritePty :: Pty -> IO () Source #
Equivalent to threadWaitWrite.
threadWaitReadPtySTM :: Pty -> IO (STM (), IO ()) Source #
Equivalent to threadWaitReadSTM.
threadWaitWritePtySTM :: Pty -> IO (STM (), IO ()) Source #
Equivalent to threadWaitWriteSTM.
Re-exports of System.Posix.Terminal
This module re-exports the entirety of System.Posix.Terminal, with the exception of the following functions:
- setTerminalProcessGroupID
- This function can't be used after a process using
the slave terminal has been created, rendering it mostly useless for working
with
Ptyscreated by this module. - queryTerminal
- Useless,
Ptyis always a terminal. - openPseudoTerminal
- Only useful for the kind of tasks this module is supposed abstract away.
In addition, some functions from System.Posix.Terminal work directly with
Fds, these have been hidden and instead the following replacements working
on Ptys are exported.
setTerminalAttributes :: Pty -> TerminalAttributes -> TerminalState -> IO () Source #
drainOutput :: Pty -> IO () Source #
See drainOutput.
discardData :: Pty -> QueueSelector -> IO () Source #
See discardData.
controlFlow :: Pty -> FlowAction -> IO () Source #
See controlFlow.
getTerminalName :: Pty -> IO FilePath Source #
See getTerminalName.
getSlaveTerminalName :: Pty -> IO FilePath Source #
See getSlaveTerminalName.
getControllingTerminalName :: IO FilePath #
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).
withMinInput :: TerminalAttributes -> Int -> TerminalAttributes #
minInput :: TerminalAttributes -> Int #
withTime :: TerminalAttributes -> Int -> TerminalAttributes #
inputTime :: TerminalAttributes -> Int #
withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes #
controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char #
withBits :: TerminalAttributes -> Int -> TerminalAttributes #
bitsPerByte :: TerminalAttributes -> Int #
terminalMode :: TerminalMode -> TerminalAttributes -> Bool #
data TerminalAttributes #
data TerminalMode #
Constructors
data TerminalState #
Constructors
| Immediately | |
| WhenDrained | |
| WhenFlushed |
data QueueSelector #
Constructors
| InputQueue | |
| OutputQueue | |
| BothQueues |
data FlowAction #
Constructors
| SuspendOutput | TCOOFF |
| RestartOutput | TCOON |
| TransmitStop | TCIOFF |
| TransmitStart | TCION |