diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Script/Shell.hs | 31 |
1 files changed, 31 insertions, 0 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 |