diff options
| -rw-r--r-- | src/Parser/Core.hs | 2 | ||||
| -rw-r--r-- | src/Parser/Shell.hs | 22 | ||||
| -rw-r--r-- | src/Script/Shell.hs | 30 | ||||
| -rw-r--r-- | test/asset/shell/pipe.et | 20 | ||||
| -rw-r--r-- | test/script/shell.et | 22 |
5 files changed, 88 insertions, 8 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index f44e721..786fb2e 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -236,7 +236,7 @@ osymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy operatorChar) wsymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy wordChar) <* sc operatorChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) -operatorChar = satisfy $ (`elem` ['.', '+', '-', '*', '/', '=']) +operatorChar = satisfy $ (`elem` [ '.', '+', '-', '*', '/', '=', '<', '>', '|' ]) {-# INLINE operatorChar #-} localState :: TestParser a -> TestParser a diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs index ffc8cf1..b575842 100644 --- a/src/Parser/Shell.hs +++ b/src/Parser/Shell.hs @@ -71,9 +71,29 @@ parseTextArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 [ char ' ' >> return " " ] +parseRedirection :: TestParser (Expr ShellArgument) +parseRedirection = choice + [ do + osymbol "<" + fmap ShellRedirectStdin <$> parseTextArgument + , do + osymbol ">" + fmap (ShellRedirectStdout False) <$> parseTextArgument + , do + osymbol ">>" + fmap (ShellRedirectStdout True) <$> parseTextArgument + , do + osymbol "2>" + fmap (ShellRedirectStderr False) <$> parseTextArgument + , do + osymbol "2>>" + fmap (ShellRedirectStderr True) <$> parseTextArgument + ] + parseArgument :: TestParser (Expr ShellArgument) parseArgument = choice - [ fmap ShellArgument <$> parseTextArgument + [ parseRedirection + , fmap ShellArgument <$> parseTextArgument ] parseArguments :: TestParser (Expr [ ShellArgument ]) diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index d53fe2e..15c0c2c 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -24,6 +24,7 @@ import Foreign.Marshal.Array import Foreign.Storable import System.Exit +import System.FilePath import System.IO import System.Posix.IO qualified as P import System.Posix.Process @@ -59,9 +60,12 @@ data ShellCommand = ShellCommand data ShellArgument = ShellArgument Text + | ShellRedirectStdin Text + | ShellRedirectStdout Bool Text + | ShellRedirectStderr Bool Text cmdArguments :: ShellCommand -> [ Text ] -cmdArguments = catMaybes . map (\case ShellArgument x -> Just x) . cmdExtArguments +cmdArguments = catMaybes . map (\case ShellArgument x -> Just x; _ -> Nothing) . cmdExtArguments instance ExprType ShellScript where textExprType _ = T.pack "ShellScript" @@ -107,19 +111,35 @@ handledHandle (KeepHandle h) = h executeCommand :: ShellExecInfo -> HandleHandling -> HandleHandling -> HandleHandling -> ShellCommand -> TestRun () executeCommand ShellExecInfo {..} pstdin pstdout pstderr scmd@ShellCommand {..} = do let args = cmdArguments scmd + ( pstdin', pstdout', pstderr' ) <- (\f -> foldM f ( pstdin, pstdout, pstderr ) cmdExtArguments) $ \cur@( cin, cout, cerr ) -> \case + ShellRedirectStdin path -> do + closeIfRequested cin + h <- liftIO $ openBinaryFile (nodeDir seiNode </> T.unpack path) ReadMode + return ( CloseHandle h, cout, cerr ) + ShellRedirectStdout append path -> do + closeIfRequested cout + h <- liftIO $ openBinaryFile (nodeDir seiNode </> T.unpack path) $ if append then AppendMode else WriteMode + return ( cin, CloseHandle h, cerr ) + ShellRedirectStderr append path -> do + closeIfRequested cerr + h <- liftIO $ openBinaryFile (nodeDir seiNode </> T.unpack path) $ if append then AppendMode else WriteMode + return ( cin, cout, CloseHandle h ) + _ -> do + return cur + pid <- liftIO $ do (_, _, _, phandle) <- createProcess_ "shell" (proc (T.unpack cmdCommand) (map T.unpack args)) - { std_in = UseHandle $ handledHandle pstdin - , std_out = UseHandle $ handledHandle pstdout - , std_err = UseHandle $ handledHandle pstderr + { std_in = UseHandle $ handledHandle pstdin' + , std_out = UseHandle $ handledHandle pstdout' + , std_err = UseHandle $ handledHandle pstderr' , cwd = Just (nodeDir seiNode) , env = Just [] } Just pid <- getPid phandle return pid - mapM_ closeIfRequested [ pstdin, pstdout, pstderr ] + mapM_ closeIfRequested [ pstdin', pstdout', pstderr' ] liftIO (getProcessStatus True False pid) >>= \case Just (Exited ExitSuccess) -> do return () diff --git a/test/asset/shell/pipe.et b/test/asset/shell/pipe.et index 64dcb07..a00360a 100644 --- a/test/asset/shell/pipe.et +++ b/test/asset/shell/pipe.et @@ -3,3 +3,23 @@ test Pipe: shell on n as sh: echo abcd | grep -o '[bc]*' echo abcd | grep -o '[bcd]*' | grep -o '[ab]*' + + +test Redirect: + node n + shell on n as sh: + echo a > file + echo b > file + echo c >> file + echo x + cat file + echo y + cat < file + echo z + +test PipeRedirect: + node n + shell on n as sh: + echo abcdefghi | grep -o '[b-h]*' | grep -o '[a-g]*' > file + cat < file | grep -o '[acegi]' | cat > file2 + cat file2 - < file diff --git a/test/script/shell.et b/test/script/shell.et index 2fe4ec3..282df37 100644 --- a/test/script/shell.et +++ b/test/script/shell.et @@ -74,7 +74,27 @@ test ShellPipe: expect_next_stdout from p: "bc" "b" - with p: expect /run-test-result Pipe done/ + + expect_next_stdout from p: + "x" + "b" + "c" + "y" + "b" + "c" + "z" + with p: + expect /run-test-result Redirect done/ + + expect_next_stdout from p: + "c" + "e" + "g" + "bcdefg" + with p: + expect /run-test-result PipeRedirect done/ + + with p: expect /run-all-done/ |