Commit 34fe1da3 authored by Steffen Michels's avatar Steffen Michels

fix System.Process.runProcessPty

parent 773f6857
Pipeline #8195 failed with stage
in 1 minute and 17 seconds
...@@ -98,29 +98,23 @@ runProcessPty path args mCurrentDirectory world ...@@ -98,29 +98,23 @@ runProcessPty path args mCurrentDirectory world
| slavePty == -1 = getLastOSError world | slavePty == -1 = getLastOSError world
# (slavePty, world) = ptsname masterPty world # (slavePty, world) = ptsname masterPty world
| slavePty == 0 = getLastOSError world | slavePty == 0 = getLastOSError world
// StdOut
# (pipeStdOut, world) = openPipe world
| isError pipeStdOut = (liftError pipeStdOut, world)
# (pipeStdOutOut, pipeStdOutIn) = fromOk pipeStdOut
// StdErr // StdErr
# (pipeStdErr, world) = openPipe world # (pipeStdErr, world) = openPipe world
| isError pipeStdErr = (liftError pipeStdErr, world) | isError pipeStdErr = (liftError pipeStdErr, world)
# (pipeStdErrOut, pipeStdErrIn) = fromOk pipeStdErr # (pipeStdErrOut, pipeStdErrIn) = fromOk pipeStdErr
= runProcessFork (childProcess slavePty pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn) = runProcessFork (childProcess slavePty pipeStdErrOut pipeStdErrIn)
(parentProcess masterPty pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn) (parentProcess masterPty pipeStdErrOut pipeStdErrIn)
world world
where where
childProcess :: !Pointer !Int !Int!Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World) childProcess :: !Pointer !Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World)
childProcess pipeStdIn pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn pipeExecErrorOut pipeExecErrorIn world childProcess pipePty pipeStdErrOut pipeStdErrIn pipeExecErrorOut pipeExecErrorIn world
//redirect stdin/out/err to pipes //redirect stdin/out/err to pipes
# (res, world) = open pipeStdIn (O_RDWR bitor O_NOCTTY) world # (pty, world) = open pipePty (O_RDWR bitor O_NOCTTY) world
| res == -1 = getLastOSError world | pty == -1 = getLastOSError world
# (res, world) = dup2 res STDIN_FILENO world # (res, world) = dup2 pty STDIN_FILENO world
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
# (res, world) = dup2 pipeStdOutIn STDOUT_FILENO world # (res, world) = dup2 pty STDOUT_FILENO world
| res == -1 = getLastOSError world
# (res, world) = close pipeStdOutOut world
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
# (res, world) = dup2 pipeStdErrIn STDERR_FILENO world # (res, world) = dup2 pipeStdErrIn STDERR_FILENO world
...@@ -131,17 +125,15 @@ where ...@@ -131,17 +125,15 @@ where
// this is never executed as 'childProcessExec' never returns // this is never executed as 'childProcessExec' never returns
= (undef, world) = (undef, world)
parentProcess :: !Int !Int !Int!Int !Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World) parentProcess :: !Int !Int !Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World)
parentProcess pipeStdIn pipeStdOutOut pipeStdOutIn pipeStdErrOut pipeStdErrIn pid pipeExecErrorOut pipeExecErrorIn world parentProcess pipePty pipeStdErrOut pipeStdErrIn pid pipeExecErrorOut pipeExecErrorIn world
# (res, world) = close pipeStdOutIn world
| res == -1 = getLastOSError world
# (res, world) = close pipeStdErrIn world # (res, world) = close pipeStdErrIn world
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
# (mbPHandle, world) = runProcessParentProcessCheckError pid pipeExecErrorOut pipeExecErrorIn world # (mbPHandle, world) = runProcessParentProcessCheckError pid pipeExecErrorOut pipeExecErrorIn world
| isError mbPHandle = (liftError mbPHandle, world) | isError mbPHandle = (liftError mbPHandle, world)
= ( Ok ( fromOk mbPHandle = ( Ok ( fromOk mbPHandle
, { stdIn = WritePipe pipeStdIn , { stdIn = WritePipe pipePty
, stdOut = ReadPipe pipeStdOutOut , stdOut = ReadPipe pipePty
, stdErr = ReadPipe pipeStdErrOut , stdErr = ReadPipe pipeStdErrOut
} }
) )
...@@ -373,7 +365,8 @@ closeProcessIO :: !ProcessIO !*World -> (!MaybeOSError (), !*World) ...@@ -373,7 +365,8 @@ closeProcessIO :: !ProcessIO !*World -> (!MaybeOSError (), !*World)
closeProcessIO {stdIn = WritePipe fdStdIn, stdOut = ReadPipe fdStdOut, stdErr = ReadPipe fdStdErr} world closeProcessIO {stdIn = WritePipe fdStdIn, stdOut = ReadPipe fdStdOut, stdErr = ReadPipe fdStdErr} world
# (res, world) = close fdStdIn world # (res, world) = close fdStdIn world
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
# (res, world) = close fdStdOut world // if 'runProcessPty' is used, the same file descriptor is used for stdIn & stdOut
# (res, world) = if (fdStdIn == fdStdOut) (0, world) (close fdStdOut world)
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
# (res, world) = close fdStdErr world # (res, world) = close fdStdErr world
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
......
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