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

Add support for starting processes with a pty

See merge request !75

src/libraries/OS-Linux/System/_Posix.dcl

@@ -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)

src/libraries/OS-Linux/System/_Posix.icl

@@ -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"

src/libraries/OS-Mac/System/_Posix.dcl

@@ -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)

src/libraries/OS-Mac/System/_Posix.icl

@@ -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"

src/libraries/OS-Posix/System/Process.dcl

@@ -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

src/libraries/OS-Posix/System/Process.icl

@@ -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

src/libraries/OS-Windows/System/Process.dcl

@@ -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