Commit f5903e2e authored by Mart Lubbers's avatar Mart Lubbers

use select instead of FIONREAD

parent bb1475f1
Pipeline #41939 failed with stage
in 1 minute and 2 seconds
......@@ -24,6 +24,8 @@ import System._Posix
import Text.GenJSON
DEFAULT_READ_BUF :== 1024
:: WritePipe = WritePipe !Int
:: ReadPipe = ReadPipe !Int
......@@ -120,6 +122,10 @@ runProcessPty path args mCurrentDirectory opts world
where
childProcess :: !Int !Int !Int !Int !*World -> (!MaybeOSError (!ProcessHandle, !ProcessIO), !*World)
childProcess slavePty masterPty pipeExecErrorOut pipeExecErrorIn world
//Close the master side
# (res, world) = close masterPty world
| res == -1 = getLastOSError world
//Disable echo
//sizeof(struct termios) on linux gives 60, on mac 72, lets play safe
# termios = malloc 128
......@@ -132,11 +138,15 @@ where
# (res, world) = tcsetattr slavePty TCSANOW termios world
| res == -1 = getLastOSError world
# world = freeSt termios world
//Close the master side
# (res, world) = close masterPty world
| res == -1 = getLastOSError world
//Close our stdio
# (res, world) = close STDIN_FILENO world
| res == -1 = getLastOSError world
# (res, world) = close STDOUT_FILENO world
| res == -1 = getLastOSError world
# (res, world) = close STDERR_FILENO world
| res == -1 = getLastOSError world
//Connect the pty to the stdio
# (res, world) = dup2 slavePty STDIN_FILENO world
| res == -1 = getLastOSError world
......@@ -145,6 +155,10 @@ where
# (res, world) = dup2 slavePty STDERR_FILENO world
| res == -1 = getLastOSError world
// Close slavePty since it is duped anyway
# (res, world) = close slavePty world
| res == -1 = getLastOSError world
//Set the correct ioctl settings
# world = (if opts.childInNewSession setsid id) world
# (res, world) = if opts.childControlsTty (0, world)
......@@ -340,63 +354,65 @@ callProcess path args mCurrentDirectory world
readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeNonBlocking (ReadPipe fd) world
# ptr = malloc 4
# (res, world) = ioctl fd FIONREAD ptr world
| res == -1
# world = freeSt ptr world
= getLastOSError world
# (n, ptr) = readP (\ptr -> readInt4Z ptr 0) ptr
# world = freeSt ptr world
| n == 0 = (Ok "", world)
# buffer = malloc n
# (res, world) = read fd buffer n world
| res == -1
# world = freeSt buffer world
= getLastOSError world
# (str, buffer) = readP (\ptr -> derefCharArray ptr n) buffer
# world = freeSt buffer world
= (Ok str, world)
# timeout = writeInt (writeInt (malloc 16) 0 0) 8 0
# (res, world) = readSelect [fd] timeout world
| isError res = (liftError res, world)
| and (fromOk res) = realRead fd world
= (Ok "", world)
readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeBlocking pipe=:(ReadPipe fd) world
# readfds = malloc 128
// init array
# readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds
// set bit for fd
# readfds = readPipeBlockingSetFdBit fd readfds
// wait
# (res, world) = select_ (fd + 1) readfds 0 0 0 world
# world = freeSt readfds world
| res == -1 = getLastOSError world
= readPipeNonBlocking pipe world
readPipeBlocking (ReadPipe fd) world
# (res, world) = readSelect [fd] 0 world
| isError res = (liftError res, world)
= realRead fd world
readPipeBlockingMulti :: ![ReadPipe] !*World -> (!MaybeOSError [String], !*World)
readPipeBlockingMulti pipes world
#readfds = malloc 128
// init array
#readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds
// set bits for fds
#readfds = seq [readPipeBlockingSetFdBit fd \\ ReadPipe fd <- pipes] readfds
// wait
# (res, world) = select_ (maxFd + 1) readfds 0 0 0 world
# world = freeSt readfds world
| res == -1 = getLastOSError world
= seq [ \(res, world) -> case res of
Ok res`
#(r, world) = readPipeNonBlocking pipe world
= (seqErrors r (\r` -> Ok [r`:res`]), world)
error = (error, world)
\\ pipe <- reverse pipes
]
(Ok [], world)
# (res, world) = readSelect [fd\\ReadPipe fd<-pipes] 0 world
| isError res = (liftError res, world)
= seq
[ \(res, world) -> case res of
Ok res`
# (r, world) = if ready
(realRead fd world)
(Ok "", world)
= (seqErrors r (\r` -> Ok [r`:res`]), world)
error = (error, world)
\\ ReadPipe fd <- reverse pipes & ready <- reverse (fromOk res)
]
(Ok [], world)
realRead :: !Int !*World -> (!MaybeOSError String, !*World)
realRead fd world
# (buf, world) = mallocSt DEFAULT_READ_BUF world
# (res, world) = read fd buf DEFAULT_READ_BUF world
| res == -1
= getLastOSError (freeSt buf world)
# (str, buf) = readP (\ptr->derefCharArray ptr res) buf
= (Ok str, freeSt buf world)
readSelect :: ![Int] !Pointer !*World -> (!MaybeOSError [Bool], !*World)
readSelect fds timeout world
# readfds = malloc 128
# readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds
# readfds = seq [setFdBit fd\\fd<-fds] readfds
# (res, world) = select_ (maximum fds + 1) readfds 0 0 timeout world
| res == -1 = getLastOSError world
# res = [getFdBit fd readfds\\fd<-fds]
# world = freeSt readfds world
= (Ok res, world)
where
maxFd = maximum [fd \\ ReadPipe fd <- pipes]
readPipeBlockingSetFdBit :: !Int !Pointer -> Pointer
readPipeBlockingSetFdBit fd ptr
# offset = fromInt fd / IF_INT_64_OR_32 64 32
# val = (readIntElemOffset ptr offset) bitor (1 << (fd rem IF_INT_64_OR_32 64 32))
= writeIntElemOffset ptr offset val
setFdBit :: !Int !Pointer -> Pointer
setFdBit fd ptr
# offset = fromInt fd / IF_INT_64_OR_32 64 32
# val = (readIntElemOffset ptr offset) bitor (1 << (fd rem IF_INT_64_OR_32 64 32))
= writeIntElemOffset ptr offset val
getFdBit :: !Int !Pointer -> Bool
getFdBit fd ptr
# offset = fromInt fd / IF_INT_64_OR_32 64 32
# val = (readIntElemOffset ptr offset) bitand (1 << (fd rem IF_INT_64_OR_32 64 32))
= val <> 0
writePipe :: !String !WritePipe !*World -> (!MaybeOSError (), !*World)
writePipe str (WritePipe fd) world
......
......@@ -7,8 +7,8 @@ import Data.Error
import Data.Func
import Text
pty = runProcessPty "/bin/sh" ["-c", "sleep 1 && echo bork"] Nothing defaultPtyOptions
pio = runProcessIO "/bin/sh" ["-c", "sleep 1 && echo bork"] Nothing
pty = runProcessPty "/bin/sh" ["-c", "sleep 2 && echo bork"] Nothing defaultPtyOptions
pio = runProcessIO "/bin/sh" ["-c", "sleep 2 && echo bork"] Nothing
test msg expected rpf pf world
# (Ok (handle,io),world) = pf 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