Commit 773f6857 authored by Mart Lubbers's avatar Mart Lubbers

Merge branch 'add-process-with-pseudo-tty' into 'master'

Add support for starting processes with a pty

See merge request !75
parents 27b43b05 b6d8c9dc
Pipeline #8194 failed with stage
in 1 minute and 21 seconds
......@@ -29,6 +29,9 @@ FIONREAD :== 0x541B
F_SETFD :== 2
FD_CLOEXEC :== 1
O_RDWR :== 02
O_NOCTTY :== 0400
//Posix API calls
errno :: !*w -> (!Int,!*w)
strerr :: !Int -> Pointer
......@@ -47,6 +50,11 @@ opendir :: !{#Char} !*w -> (!Pointer,!*w)
closedir :: !Pointer !*w -> (!Int,!*w)
readdir :: !Pointer !*w -> (!Pointer,!*w)
pipe :: !Pointer !*w -> (!Int, !*w)
posix_openpt :: !Int !*w -> (!Int, !*w)
grantpt :: !Int !*w -> (!Int, !*w)
unlockpt :: !Int !*w -> (!Int, !*w)
ptsname :: !Int !*w -> (!Pointer, !*w)
open :: !Pointer !Int !*w -> (!Int, !*w)
dup2 :: !Int !Int !*w -> (!Int, !*w)
close :: !Int !*w -> (!Int, !*w)
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
......
......@@ -76,12 +76,30 @@ readdir :: !Pointer !*w -> (!Pointer,!*w)
readdir dir world = code {
ccall readdir "p:p:A"
}
pipe :: !Pointer !*w -> (!Int, !*w)
pipe arr world = code {
ccall pipe "p:I:A"
}
posix_openpt :: !Int !*w -> (!Int, !*w)
posix_openpt flags w = code {
ccall posix_openpt "I:I:A"
}
grantpt :: !Int !*w -> (!Int, !*w)
grantpt fp w = code {
ccall grantpt "I:I:A"
}
unlockpt :: !Int !*w -> (!Int, !*w)
unlockpt fp w = code {
ccall unlockpt "I:I:A"
}
ptsname :: !Int !*w -> (!Pointer, !*w)
ptsname fp w = code {
ccall ptsname "I:p:A"
}
open :: !Pointer !Int !*w -> (!Int, !*w)
open p flags w = code {
ccall open "pI:I:A"
}
dup2 :: !Int !Int !*w -> (!Int, !*w)
dup2 old new world = code {
ccall dup2 "II:I:A"
......
......@@ -28,6 +28,9 @@ FIONREAD :== 0x4004667F
F_SETFD :== 2
FD_CLOEXEC :== 1
O_RDWR :== 02
O_NOCTTY :== 0400
//Posix API calls
errno :: !*w -> (!Int,!*w)
strerr :: !Int -> Pointer
......@@ -46,6 +49,11 @@ opendir :: !{#Char} !*w -> (!Pointer,!*w)
closedir :: !Pointer !*w -> (!Int,!*w)
readdir :: !Pointer !*w -> (!Pointer,!*w)
pipe :: !Pointer !*w -> (!Int, !*w)
posix_openpt :: !Int !*w -> (!Int, !*w)
grantpt :: !Int !*w -> (!Int, !*w)
unlockpt :: !Int !*w -> (!Int, !*w)
ptsname :: !Int !*w -> (!Pointer, !*w)
open :: !Pointer !Int !*w -> (!Int, !*w)
dup2 :: !Int !Int !*w -> (!Int, !*w)
close :: !Int !*w -> (!Int, !*w)
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
......
......@@ -80,7 +80,26 @@ pipe :: !Pointer !*w -> (!Int, !*w)
pipe arr world = code {
ccall pipe "p:I:A"
}
posix_openpt :: !Int !*w -> (!Int, !*w)
posix_openpt flags w = code {
ccall posix_openpt "I:I:A"
}
grantpt :: !Int *w -> (!Int, !*w)
grantpt fp w = code {
ccall grantpt "I:I:A"
}
unlockpt :: !Int *w -> (!Int, !*w)
unlockpt fp w = code {
ccall unlockpt "I:I:A"
}
ptsname :: !Int *w -> (!Pointer, !*w)
ptsname fp w = code {
ccall ptsname "I:p:A"
}
open :: !Pointer !Int !*w -> (!Int, !*w)
open p flags w = code {
ccall open "pI:I:A"
}
dup2 :: !Int !Int !*w -> (!Int, !*w)
dup2 old new world = code {
ccall dup2 "II:I:A"
......
......@@ -38,6 +38,15 @@ runProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError Proce
*/
runProcessIO :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError (ProcessHandle, ProcessIO), *World)
/**
* runs a new process and a pty for IO
* @param Path to the executable
* @param a list of command-line arguments
* @param (optional) startup directory
* @return Process handle to the process and pipes for IO
*/
runProcessPty :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError (ProcessHandle, ProcessIO), *World)
/**
* Check if a process is still running
* @param Process handle to the process
......
......@@ -88,6 +88,66 @@ where
, world
)
runProcessPty :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError (ProcessHandle, ProcessIO), *World)
runProcessPty path args mCurrentDirectory world
# (masterPty, world) = posix_openpt (O_RDWR bitor O_NOCTTY) world
| masterPty == -1 = getLastOSError world
# (slavePty, world) = grantpt masterPty world
| slavePty == -1 = getLastOSError world
# (slavePty, world) = unlockpt masterPty world
| slavePty == -1 = getLastOSError world
# (slavePty, world) = ptsname masterPty world
| slavePty == 0 = getLastOSError world
// StdOut
# (pipeStdOut, world) = openPipe world
| isError pipeStdOut = (liftError pipeStdOut, world)
# (pipeStdOutOut, pipeStdOutIn) = fromOk pipeStdOut
// StdErr
# (pipeStdErr, world) = openPipe world
| isError pipeStdErr = (liftError pipeStdErr, world)
# (pipeStdErrOut, pipeStdErrIn) = fromOk pipeStdErr
= runProcessFork (childProcess slavePty pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn)
(parentProcess masterPty pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn)
world
where
childProcess :: !Pointer !Int !Int!Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World)
childProcess pipeStdIn pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn pipeExecErrorOut pipeExecErrorIn world
//redirect stdin/out/err to pipes
# (res, world) = open pipeStdIn (O_RDWR bitor O_NOCTTY) world
| res == -1 = getLastOSError world
# (res, world) = dup2 res STDIN_FILENO world
| res == -1 = getLastOSError world
# (res, world) = dup2 pipeStdOutIn STDOUT_FILENO world
| res == -1 = getLastOSError world
# (res, world) = close pipeStdOutOut world
| res == -1 = getLastOSError world
# (res, world) = dup2 pipeStdErrIn STDERR_FILENO world
| res == -1 = getLastOSError world
# (res, world) = close pipeStdErrOut world
| res == -1 = getLastOSError world
# (_, world) = runProcessChildProcessExec path args mCurrentDirectory pipeExecErrorOut pipeExecErrorIn world
// this is never executed as 'childProcessExec' never returns
= (undef, world)
parentProcess :: !Int !Int !Int!Int !Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World)
parentProcess pipeStdIn pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn pid pipeExecErrorOut pipeExecErrorIn world
# (res, world) = close pipeStdOutIn world
| res == -1 = getLastOSError world
# (res, world) = close pipeStdErrIn world
| res == -1 = getLastOSError world
# (mbPHandle, world) = runProcessParentProcessCheckError pid pipeExecErrorOut pipeExecErrorIn world
| isError mbPHandle = (liftError mbPHandle, world)
= ( Ok ( fromOk mbPHandle
, { stdIn = WritePipe pipeStdIn
, stdOut = ReadPipe pipeStdOutOut
, stdErr = ReadPipe pipeStdErrOut
}
)
, world
)
runProcessFork :: !( Int Int *World -> (!MaybeOSError a, !*World))
!(Int Int Int *World -> (!MaybeOSError a, !*World))
!*World
......
......@@ -41,6 +41,16 @@ runProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError Proce
*/
runProcessIO :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError (ProcessHandle, ProcessIO), *World)
/**
* runs a new process and a pty for IO
* on windows, pty's do not exist thus this is just an alias
* @param Path to the executable
* @param a list of command-line arguments
* @param (optional) startup directory
* @return Process handle to the process and pipes for IO
*/
runProcessPty :== runProcessIO
/**
* Check if a process is still running
* @param Process handle to the process
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment