Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-platform
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-platform
Commits
34fe1da3
Commit
34fe1da3
authored
Nov 07, 2017
by
Steffen Michels
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fix System.Process.runProcessPty
parent
773f6857
Pipeline
#8195
failed with stage
in 1 minute and 17 seconds
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
14 additions
and
21 deletions
+14
-21
src/libraries/OS-Posix/System/Process.icl
src/libraries/OS-Posix/System/Process.icl
+14
-21
No files found.
src/libraries/OS-Posix/System/Process.icl
View file @
34fe1da3
...
...
@@ -98,29 +98,23 @@ runProcessPty path args mCurrentDirectory 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
pipeStd
OutOut
pipeStdOutIn
pipeStd
ErrOut
pipeStdErrIn
)
(
parentProcess
masterPty
pipeStd
OutOut
pipeStdOutIn
pipeStd
ErrOut
pipeStdErrIn
)
=
runProcessFork
(
childProcess
slavePty
pipeStdErrOut
pipeStdErrIn
)
(
parentProcess
masterPty
pipeStdErrOut
pipeStdErrIn
)
world
where
childProcess
::
!
Pointer
!
Int
!
Int
!
Int
!
Int
!
Int
!
Int
!*
World
->
(!
MaybeOSError
(!
ProcessHandle
,
!
ProcessIO
),
!*
World
)
childProcess
pipe
StdIn
pipeStdOutOut
pipeStdOutIn
pipeStdErrOut
pipeStdErrIn
pipeExecErrorOut
pipeExecErrorIn
world
childProcess
::
!
Pointer
!
Int
!
Int
!
Int
!
Int
!*
World
->
(!
MaybeOSError
(!
ProcessHandle
,
!
ProcessIO
),
!*
World
)
childProcess
pipe
Pty
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
#
(
pty
,
world
)
=
open
pipePty
(
O_RDWR
bitor
O_NOCTTY
)
world
|
pty
==
-1
=
getLastOSError
world
#
(
res
,
world
)
=
dup2
pty
STDIN_FILENO
world
|
res
==
-1
=
getLastOSError
world
#
(
res
,
world
)
=
dup2
pipeStdOutIn
STDOUT_FILENO
world
|
res
==
-1
=
getLastOSError
world
#
(
res
,
world
)
=
close
pipeStdOutOut
world
#
(
res
,
world
)
=
dup2
pty
STDOUT_FILENO
world
|
res
==
-1
=
getLastOSError
world
#
(
res
,
world
)
=
dup2
pipeStdErrIn
STDERR_FILENO
world
...
...
@@ -131,17 +125,15 @@ where
// 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
parentProcess
::
!
Int
!
Int
!
Int
!
Int
!
Int
!
Int
!*
World
->
(!
MaybeOSError
(!
ProcessHandle
,
!
ProcessIO
),
!*
World
)
parentProcess
pipePty
pipeStdErrOut
pipeStdErrIn
pid
pipeExecErrorOut
pipeExecErrorIn
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
pipe
StdIn
,
stdOut
=
ReadPipe
pipe
StdOutOut
,
{
stdIn
=
WritePipe
pipe
Pty
,
stdOut
=
ReadPipe
pipe
Pty
,
stdErr
=
ReadPipe
pipeStdErrOut
}
)
...
...
@@ -373,7 +365,8 @@ closeProcessIO :: !ProcessIO !*World -> (!MaybeOSError (), !*World)
closeProcessIO
{
stdIn
=
WritePipe
fdStdIn
,
stdOut
=
ReadPipe
fdStdOut
,
stdErr
=
ReadPipe
fdStdErr
}
world
#
(
res
,
world
)
=
close
fdStdIn
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
,
world
)
=
close
fdStdErr
world
|
res
==
-1
=
getLastOSError
world
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment