From 0474544d0b9adbd6516a95e5a409c2bbf559b36a Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Sat, 28 Sep 2019 14:24:23 +0200 Subject: [PATCH] Implement defaultExec --- .envrc | 5 ++ arion-compose.cabal | 1 + src/haskell/exe/Main.hs | 83 ++++++++++++++++++++++++++++--- src/haskell/lib/Arion/Images.hs | 1 + src/haskell/lib/Arion/Nix.hs | 1 - src/haskell/lib/Arion/Services.hs | 27 ++++++++++ 6 files changed, 111 insertions(+), 7 deletions(-) create mode 100644 .envrc create mode 100644 src/haskell/lib/Arion/Services.hs diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..0974ec7 --- /dev/null +++ b/.envrc @@ -0,0 +1,5 @@ +eval "$(lorri direnv)" + +# Use system PKI +unset SSL_CERT_FILE +unset NIX_SSL_CERT_FILE diff --git a/arion-compose.cabal b/arion-compose.cabal index 40a45be..77891a7 100644 --- a/arion-compose.cabal +++ b/arion-compose.cabal @@ -50,6 +50,7 @@ library Arion.Aeson Arion.DockerCompose Arion.Images + Arion.Services other-modules: Paths_arion_compose -- other-extensions: hs-source-dirs: src/haskell/lib diff --git a/src/haskell/exe/Main.hs b/src/haskell/exe/Main.hs index fb29f89..21ec3d3 100644 --- a/src/haskell/exe/Main.hs +++ b/src/haskell/exe/Main.hs @@ -3,15 +3,17 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} -import Protolude hiding (Down) +import Protolude hiding (Down, option) import Arion.Nix import Arion.Aeson import Arion.Images (loadImages) import qualified Arion.DockerCompose as DockerCompose +import Arion.Services (getDefaultExec) import Options.Applicative import Control.Applicative +import Control.Monad.Fail import qualified Data.Aeson.Encode.Pretty import qualified Data.Text as T @@ -74,7 +76,7 @@ parseCommand = hsubparser ( command "cat" (info (pure runCat) (progDesc "Spit out the docker compose file as JSON" <> fullDesc)) <> command "repl" (info (pure runRepl) (progDesc "Start a nix repl for the whole composition" <> fullDesc)) - -- <> command "exec" (info (pure runExec) (progDesc "TODO: exec doc" <> fullDesc)) + <> command "exec" (info (parseExecCommand) (progDesc "Execute a command in a running container" <> fullDesc)) ) <|> hsubparser @@ -84,7 +86,6 @@ parseCommand = <> commandDC runBuildAndDC "create" "Create services" <> commandDC runEvalAndDC "down" "Stop and remove containers, networks, images, and volumes" <> commandDC runEvalAndDC "events" "Receive real time events from containers" - <> commandDC runEvalAndDC "exec" "Execute a command in a running container" <> commandDC runDC "help" "Get help on a command" <> commandDC runEvalAndDC "images" "List images" <> commandDC runEvalAndDC "kill" "Kill containers" @@ -190,9 +191,79 @@ runRepl co = do \" Arion.Nix.replForComposition =<< defaultEvaluationArgs co -runExec :: CommonOptions -> IO () -runExec opts = - T.putStrLn "Running exec ... TODO" +detachFlag :: Parser Bool +detachFlag = flag False True (long "detach" <> short 'd' <> help "Detached mode: Run command in the background.") + +privilegedFlag :: Parser Bool +privilegedFlag = flag False True (long "privileged" <> help "Give extended privileges to the process.") + +userOption :: Parser Text +userOption = strOption (long "user" <> short 'u' <> help "Run the command as this user.") + +noTTYFlag :: Parser Bool +noTTYFlag = flag False True (short 'T' <> help "Disable pseudo-tty allocation. By default `exec` allocates a TTY.") + +indexOption :: Parser Int +indexOption = option + (auto >>= \i -> i <$ unless (i >= 1) (fail "container index must be >= 1")) + (long "index" <> value 1 <> help "Index of the container if there are multiple instances of a service.") + +envOption :: Parser (Text, Text) +envOption = option (auto >>= spl) (long "env" <> short 'e' <> help "Set environment variables (can be used multiple times, not supported in Docker API < 1.25)") + where spl s = case T.break (== '=') s of + (_, "") -> fail "--env parameter needs to combine key and value with = sign" + (k, ev) -> pure (k, T.drop 1 ev) + +workdirOption :: Parser Text +workdirOption = strOption (long "workdir" <> short 'w' <> metavar "DIR" <> help "Working directory in which to start the command in the container.") + +parseExecCommand :: Parser (CommonOptions -> IO ()) +parseExecCommand = runExec + <$> detachFlag + <*> privilegedFlag + <*> optional userOption + <*> noTTYFlag + <*> indexOption + <*> many envOption + <*> optional workdirOption + <*> textArgument (metavar "SERVICE") + <*> orEmpty' ( + (:) <$> argument (T.pack <$> str) (metavar "COMMAND") + <*> many (argument (T.pack <$> str) (metavar "ARG")) + ) + +orEmpty' :: (Alternative f, Monoid a) => f a -> f a +orEmpty' m = fromMaybe mempty <$> optional m + +runExec :: Bool -> Bool -> Maybe Text -> Bool -> Int -> [(Text, Text)] -> Maybe Text -> Text -> [Text] -> CommonOptions -> IO () +runExec detach privileged user noTTY index envs workDir service commandAndArgs opts = do + putErrText $ "Service: " <> service + + ea <- defaultEvaluationArgs opts + Arion.Nix.withEvaluatedComposition ea $ \path -> do + commandAndArgs'' <- case commandAndArgs of + [] -> getDefaultExec path service + x -> pure x + let commandAndArgs' = case commandAndArgs'' of + [] -> ["/bin/sh"] + x -> x + + let args = concat + [ ["exec"] + , ("--detach" <$ guard detach :: [Text]) + , "--privileged" <$ guard privileged + , "-T" <$ guard noTTY + , (\(k, v) -> ["--env", k <> "=" <> v]) =<< envs + , join $ toList (user <&> \u -> ["--user", u]) + , ["--index", show index] + , join $ toList (workDir <&> \w -> ["--workdir", w]) + , [service] + , commandAndArgs' + ] + DockerCompose.run DockerCompose.Args + { files = [path] + , otherArgs = args + } main :: IO () main = diff --git a/src/haskell/lib/Arion/Images.hs b/src/haskell/lib/Arion/Images.hs index cf52e22..369d09f 100644 --- a/src/haskell/lib/Arion/Images.hs +++ b/src/haskell/lib/Arion/Images.hs @@ -27,6 +27,7 @@ data Image = Image type TaggedImage = Text +-- | Subject to change loadImages :: FilePath -> IO () loadImages fp = do diff --git a/src/haskell/lib/Arion/Nix.hs b/src/haskell/lib/Arion/Nix.hs index 6eb40d9..bb00524 100644 --- a/src/haskell/lib/Arion/Nix.hs +++ b/src/haskell/lib/Arion/Nix.hs @@ -118,7 +118,6 @@ buildComposition outLink ea = do errDone <- async (BL.hPutStr stderr err) -- Force 'out' - -- TODO: use it? _v <- Protolude.evaluate out -- Wait for process exit and 'err' printout diff --git a/src/haskell/lib/Arion/Services.hs b/src/haskell/lib/Arion/Services.hs new file mode 100644 index 0000000..f63e6e2 --- /dev/null +++ b/src/haskell/lib/Arion/Services.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +module Arion.Services + ( getDefaultExec + ) where + +import Prelude() +import Protolude hiding (to) + +import qualified Data.Aeson as Aeson +import Arion.Aeson (decodeFile) +import qualified Data.ByteString as BS +import qualified System.Process as Process + +import Control.Lens +import Data.Aeson.Lens +import Data.String +import System.IO (withFile, IOMode(ReadMode)) + +-- | Subject to change +getDefaultExec :: FilePath -> Text -> IO [Text] +getDefaultExec fp service = do + + v <- decodeFile fp + + pure ((v :: Aeson.Value) ^.. key "x-arion" . key "serviceInfo" . key service . key "defaultExec" . _Array . traverse . _String)