Implement defaultExec

This commit is contained in:
Robert Hensing 2019-09-28 14:24:23 +02:00
parent 02c0f80b02
commit 0474544d0b
6 changed files with 111 additions and 7 deletions

5
.envrc Normal file
View file

@ -0,0 +1,5 @@
eval "$(lorri direnv)"
# Use system PKI
unset SSL_CERT_FILE
unset NIX_SSL_CERT_FILE

View file

@ -50,6 +50,7 @@ library
Arion.Aeson Arion.Aeson
Arion.DockerCompose Arion.DockerCompose
Arion.Images Arion.Images
Arion.Services
other-modules: Paths_arion_compose other-modules: Paths_arion_compose
-- other-extensions: -- other-extensions:
hs-source-dirs: src/haskell/lib hs-source-dirs: src/haskell/lib

View file

@ -3,15 +3,17 @@
{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Protolude hiding (Down) import Protolude hiding (Down, option)
import Arion.Nix import Arion.Nix
import Arion.Aeson import Arion.Aeson
import Arion.Images (loadImages) import Arion.Images (loadImages)
import qualified Arion.DockerCompose as DockerCompose import qualified Arion.DockerCompose as DockerCompose
import Arion.Services (getDefaultExec)
import Options.Applicative import Options.Applicative
import Control.Applicative import Control.Applicative
import Control.Monad.Fail
import qualified Data.Aeson.Encode.Pretty import qualified Data.Aeson.Encode.Pretty
import qualified Data.Text as T import qualified Data.Text as T
@ -74,7 +76,7 @@ parseCommand =
hsubparser hsubparser
( command "cat" (info (pure runCat) (progDesc "Spit out the docker compose file as JSON" <> fullDesc)) ( 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 "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 hsubparser
@ -84,7 +86,6 @@ parseCommand =
<> commandDC runBuildAndDC "create" "Create services" <> commandDC runBuildAndDC "create" "Create services"
<> commandDC runEvalAndDC "down" "Stop and remove containers, networks, images, and volumes" <> commandDC runEvalAndDC "down" "Stop and remove containers, networks, images, and volumes"
<> commandDC runEvalAndDC "events" "Receive real time events from containers" <> 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 runDC "help" "Get help on a command"
<> commandDC runEvalAndDC "images" "List images" <> commandDC runEvalAndDC "images" "List images"
<> commandDC runEvalAndDC "kill" "Kill containers" <> commandDC runEvalAndDC "kill" "Kill containers"
@ -190,9 +191,79 @@ runRepl co = do
\" \"
Arion.Nix.replForComposition =<< defaultEvaluationArgs co Arion.Nix.replForComposition =<< defaultEvaluationArgs co
runExec :: CommonOptions -> IO () detachFlag :: Parser Bool
runExec opts = detachFlag = flag False True (long "detach" <> short 'd' <> help "Detached mode: Run command in the background.")
T.putStrLn "Running exec ... TODO"
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 :: IO ()
main = main =

View file

@ -27,6 +27,7 @@ data Image = Image
type TaggedImage = Text type TaggedImage = Text
-- | Subject to change
loadImages :: FilePath -> IO () loadImages :: FilePath -> IO ()
loadImages fp = do loadImages fp = do

View file

@ -118,7 +118,6 @@ buildComposition outLink ea = do
errDone <- async (BL.hPutStr stderr err) errDone <- async (BL.hPutStr stderr err)
-- Force 'out' -- Force 'out'
-- TODO: use it?
_v <- Protolude.evaluate out _v <- Protolude.evaluate out
-- Wait for process exit and 'err' printout -- Wait for process exit and 'err' printout

View file

@ -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)