diff options
| -rw-r--r-- | src/Script/Shell.hs | 31 | ||||
| -rw-r--r-- | test/asset/shell/working-directory.et | 15 | ||||
| -rw-r--r-- | test/script/shell.et | 13 |
3 files changed, 58 insertions, 1 deletions
diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index fbb92af..983e40f 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -23,6 +23,7 @@ import Foreign.Ptr import Foreign.Marshal.Array import Foreign.Storable +import System.Directory import System.Exit import System.FilePath import System.IO @@ -44,6 +45,7 @@ newtype ShellScript = ShellScript [ ShellStatement ] data ShellState = ShellState { shellWorkingDirectory :: FilePath + , shellOldWorkingDirectory :: FilePath } data ShellStatement = ShellStatement @@ -154,6 +156,33 @@ executeCommand sei@ShellExecInfo {..} st pstdin pstdout pstderr scmd@ShellComman executeCommandProcess :: ShellExecInfo -> ShellState -> Handle -> Handle -> Handle -> [ Text ] -> Text -> TestRun ( TestRun ProcessStatus, ShellState ) executeCommandProcess ShellExecInfo {..} st@ShellState {..} pstdin pstdout pstderr args = \case + "cd" + | [] <- args -> liftIO $ do + hPutStrLn pstdout (nodeDir seiNode) + return ( return (Exited ExitSuccess), st + { shellWorkingDirectory = nodeDir seiNode + , shellOldWorkingDirectory = shellWorkingDirectory + } ) + | [ "-" ] <- args -> liftIO $ do + hPutStrLn pstdout shellOldWorkingDirectory + return ( return (Exited ExitSuccess), st + { shellWorkingDirectory = shellOldWorkingDirectory + , shellOldWorkingDirectory = shellWorkingDirectory + } ) + | [ dir ] <- args -> liftIO $ do + cd <- canonicalizePath $ shellWorkingDirectory </> T.unpack dir + doesDirectoryExist cd >>= \case + True -> return ( return (Exited ExitSuccess), st + { shellWorkingDirectory = cd + , shellOldWorkingDirectory = shellWorkingDirectory + } ) + False -> do + hPutStrLn pstderr $ "cd: no such directory: " <> T.unpack dir + return ( return (Exited (ExitFailure (-1))), st ) + | otherwise -> do + liftIO $ hPutStrLn pstderr $ "cd: too many arguments" + return ( return (Exited (ExitFailure (-1))), st ) + "pwd" | [] <- args -> do liftIO $ hPutStrLn pstdout shellWorkingDirectory @@ -161,6 +190,7 @@ executeCommandProcess ShellExecInfo {..} st@ShellState {..} pstdin pstdout pstde | otherwise -> do liftIO $ hPutStrLn pstderr $ "pwd: too many arguments" return ( return (Exited (ExitFailure (-1))), st ) + cmd -> liftIO $ do (_, _, _, phandle) <- createProcess_ "shell" (proc (T.unpack cmd) (map T.unpack args)) @@ -200,6 +230,7 @@ executeScript sei@ShellExecInfo {..} pstdin pstdout pstderr (ShellScript stateme setNetworkNamespace $ getNetns seiNode let initialState = ShellState { shellWorkingDirectory = nodeDir seiNode + , shellOldWorkingDirectory = nodeDir seiNode } _ <- (\f -> foldM f initialState statements) $ \st ShellStatement {..} -> do executePipeline sei st (KeepHandle pstdin) (KeepHandle pstdout) (KeepHandle pstderr) shellPipeline diff --git a/test/asset/shell/working-directory.et b/test/asset/shell/working-directory.et index e1732ee..da31e2f 100644 --- a/test/asset/shell/working-directory.et +++ b/test/asset/shell/working-directory.et @@ -2,3 +2,18 @@ test Test: node n shell on n as sh: pwd + mkdir -p abc/def/ghi + cd abc/def + pwd + cd .. + pwd + cd def/ghi + pwd + cd - + pwd + cd - + pwd + cd + pwd + cd /tmp + pwd diff --git a/test/script/shell.et b/test/script/shell.et index 2c09aa4..fbf385d 100644 --- a/test/script/shell.et +++ b/test/script/shell.et @@ -111,4 +111,15 @@ test ShellWorkingDirectory: send "run *" - expect from p /child-stdout sh (\/.*)/ capture orig_pwd + expect from p /child-stdout sh (\/.*)/ capture home + expect_next_stdout from p: + "$home/abc/def" + "$home/abc" + "$home/abc/def/ghi" + "$home/abc" + "$home/abc" + "$home/abc/def/ghi" + "$home/abc/def/ghi" + "$home" + "$home" + "/tmp" |