docker-build-cacher 1.7.1 → 1.8.0
raw patch · 3 files changed
+78/−44 lines, 3 files
Files
- README.md +9/−0
- app/Main.hs +68/−43
- docker-build-cacher.cabal +1/−1
README.md view
@@ -111,6 +111,15 @@ The effect this `FROM` swap has, is that disk state for the image is preserved between builds. +## Passing extra arguments to docker build++It is possible to pass extra arguments and flags to the `docker build` step by providing the environment variable `DOCKER_BUILD_OPTIONS` as+shown below:+++```bash+DOCKER_BUILD_OPTIONS="--build-arg foo=bar --quiet" docker-build-cacher build+``` ## Building from source
app/Main.hs view
@@ -1,7 +1,7 @@ #!/usr/bin/env stack {- stack runghc- --resolver lts-8.18+ --resolver lts-9.14 --install-ghc --package turtle --package language-dockerfile@@ -17,7 +17,7 @@ import Control.Monad (guard, when) import Data.Either (rights) import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes, isJust, mapMaybe)+import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import qualified Data.Text as Text import Data.Text (Text) import Filesystem.Path (FilePath)@@ -53,6 +53,10 @@ TargetPath FilePath deriving (Show, Eq) +newtype BuildOptions =+ BuildOptions Text+ deriving (Show)+ -- | A Stage is one of the FROM directives ina dockerfile -- data Stage = Stage@@ -89,17 +93,32 @@ where strValMap = map (\(x, y) -> lift $ string x >> return y) +data Args = Args+ { mode :: Mode+ , noCacheStages :: Bool+ , noBuildCache :: Bool+ }+ -- | Describes the arguments this script takes from the command line-parser :: Parser Mode-parser = argRead "mode" "Whether to build or to cache (options: build | cache)"+parser :: Parser Args+parser =+ Args <$> -- Pass the parsed arguments into the Args data container+ argRead "mode" "Whether to build or to cache (options: build | cache)" <*>+ switch+ "no-cache-stages"+ 's'+ "Each of the FROM instruction will be cached in separate images if this flag is not set" <*>+ switch "no-cache-build" 'n' "Skip the internal docker cache when building the image" +main :: IO () main = do- mode <- options "Builds a docker file and caches its stages" parser -- Parse the CLI arguments as a Mode+ Args {mode, noCacheStages, noBuildCache} <-+ options "Builds a docker file and caches its stages" parser -- Parse the CLI arguments as a Mode app <- App <$> needEnv "APP_NAME" -- Get the APP environment variable and then wrap it in App branch <- Branch <$> needEnv "GIT_BRANCH" maybeFile <-- do f <- need "DOCKERFILE" -- Get the dockerfile path if any- return (fmap fromText f) -- And transform it to a FilePath+ do file <- need "DOCKERFILE" -- Get the dockerfile path if any+ return (fmap fromText file) -- And transform it to a FilePath -- -- if DOCKERFILE is not present, we assume is in the current directory currentDirectory <- pwd@@ -111,19 +130,35 @@ Left message -> error ("There was an error parsing the docker file: " <> show message) Right ast -> case mode of- Cache -> sh (cacheBuild app branch ast)+ Cache ->+ if noCacheStages+ then echo "Skipping... I was told not to cache any stages separetely"+ else sh (cacheBuild app branch ast) Build -> do tag <- Tag <$> needEnv "DOCKER_TAG"- sh (build app branch tag ast)+ buildOPtions <-+ do opts <- need "DOCKER_BUILD_OPTIONS"+ if noBuildCache+ then return $+ Just (opts & fromMaybe "" & (<> " --no-cache") & BuildOptions) -- Append the docker --no-cache option+ else return (fmap BuildOptions opts)+ if noCacheStages+ then sh (build app tag buildOPtions ast)+ else sh (buildFromCache app branch tag buildOPtions ast) -- | Builds the provided Dockerfile. If it is a multi-stage build, check if those stages are already cached -- and change the dockerfile to take advantage of that.-build :: App -> Branch -> Tag -> Dockerfile -> Shell ()-build app branch tag ast = do+buildFromCache :: App -> Branch -> Tag -> Maybe BuildOptions -> Dockerfile -> Shell ()+buildFromCache app branch tag buildOptions ast = do+ liftIO . print $ buildOptions changedStages <- getChangedStages app branch ast -- Inspect the dockerfile and return the stages that got their cache invalidated- echo "I'll start building now the main Dockerfile" let bustedStages = replaceStages (filter alreadyCached changedStages) ast -- We replace the busted stages with cached primed ones- status <- buildDockerfile app tag bustedStages -- Build the main docker file with the maybe changed stages+ build app tag buildOptions bustedStages++build :: App -> Tag -> Maybe BuildOptions -> Dockerfile -> Shell ()+build app tag buildOptions ast = do+ echo "I'll start building now the main Dockerfile"+ status <- buildDockerfile app tag buildOptions ast -- Build the main docker file with the maybe changed stages case status of ExitSuccess -> echo@@ -164,7 +199,7 @@ getAlreadyCached :: [Stage] -> Shell Stage getAlreadyCached stages = do echo "--> I'm checking whether or not the stage exists as a docker image already"- stage@(Stage {stageTag}) <- select stages -- foreach stages as stage+ stage@Stage {stageTag} <- select stages -- foreach stages as stage printLn ("----> Looking for image " %s) (taggedBuild stageTag) existent <- fold@@ -184,17 +219,17 @@ -- | This will inspect how an image was build and extrack the ONBUILD directives. If any of those -- instructions are copying or adding files to the build, they are considered "cache busters". inspectCache :: Stage -> Shell InspectedStage-inspectCache stage@(Stage {..}) = do- case alreadyCached of- False -> return (NotCached stage)- True -> do+inspectCache stage@Stage {..} =+ if alreadyCached+ then return (NotCached stage)+ else do history <- imageHistory (Tag (taggedBuild stageTag)) let onBuildLines = extractOnBuild history workdir = extractWorkdir history parsedDirectivesWithErrors = fmap (parseString . Text.unpack) onBuildLines -- Parse each of the lines parsedDirectives = (getFirst . rights) parsedDirectivesWithErrors -- We only keep the good lines cacheBusters = extractCachePaths workdir parsedDirectives- return (Cached {..})+ return Cached {..} where extractCachePaths workdir dir = let filePairs = concat (mapMaybe doExtract dir) -- Get the (source, target) pairs of files copied@@ -207,7 +242,7 @@ else (source, TargetPath target) -- -- | COPY allows multiple paths in the same line, we need to convert each to a separate path- doExtract (InstructionPos (Copy fr t) _ _) =+ doExtract (InstructionPos (Copy _ t) _ _) = let target:allSources = (reverse . Text.words . Text.pack) t -- Make sure we get all the files in COPY sourcePaths = fmap toSource allSources in Just (zip sourcePaths (repeat (toTarget target)))@@ -263,11 +298,10 @@ withContainer stage action = do containerId <- inproc "docker" ["create", taggedBuild (stageTag stage)] empty result <- fold (action (format l containerId)) Fold.list- removeContainer containerId+ _ <- removeContainer containerId -- Ignore the return code of this command select result -- yield each result as a separate line where- removeContainer containerId =- proc "docker" ["rm", format l containerId] empty+ removeContainer containerId = proc "docker" ["rm", format l containerId] empty -- | The goal is to create a temporary dockefile in this same folder with the contents -- if the stage variable, call docker build with the generated file and tag the image@@ -276,11 +310,11 @@ buildAssetStage app Stage {..} = do printLn ("\n--> Building asset stage " %s % " at line " %d) stageName stagePos let filteredDirectives = filter isFrom directives- status <- buildDockerfile app stageTag filteredDirectives -- Only build the FROM+ status <- buildDockerfile app stageTag Nothing filteredDirectives -- Only build the FROM guard (status == ExitSuccess) -- Break if previous command failed history <- imageHistory stageTag -- Get the commands used to build the docker image newDockerfile <- createDockerfile stageTag (extractOnBuild history) -- Append the ONBUILD lines to the new file- finalStatus <- buildDockerfile app (Tag (taggedBuild stageTag)) newDockerfile -- Now build it+ finalStatus <- buildDockerfile app (Tag (taggedBuild stageTag)) Nothing newDockerfile -- Now build it guard (finalStatus == ExitSuccess) -- Stop here if previous command failed echo "" echo "--> I have tagged a cache container that I can use next time to speed builds!"@@ -289,25 +323,16 @@ isFrom _ = False -- | Simply call docker build for the passed arguments-buildDockerfile :: App -> Tag -> Dockerfile -> Shell ExitCode-buildDockerfile (App app) (Tag tag) directives = do+buildDockerfile :: App -> Tag -> Maybe BuildOptions -> Dockerfile -> Shell ExitCode+buildDockerfile (App app) (Tag tag) buildOPtions directives = do currentDirectory <- pwd tmpFile <- mktempfile currentDirectory "Dockerfile."+ let BuildOptions opts = fromMaybe (BuildOptions "") buildOPtions+ let allBuildOptions =+ ["build", "--build-arg", "APP_NAME=" <> app, "-f", format fp tmpFile, "-t", tag, "."] <>+ [opts] liftIO (writeTextFile tmpFile (Text.pack (prettyPrint directives))) -- Put the Dockerfile contents in the tmp file- proc- "docker"- [ "build"- , "--network"- , "host"- , "--build-arg"- , "APP_NAME=" <> app- , "-f"- , format fp tmpFile- , "-t"- , tag- , "."- ]- empty -- Build the generated dockerfile+ shell ("docker " <> Text.intercalate " " allBuildOptions) empty -- Build the generated dockerfile -- | Given a list of instructions, build a dockerfile where the tag is the FROM for the file and -- the list of instructions are wrapped with ONBUILD@@ -320,7 +345,7 @@ mapM (onBuildRaw . toInstruction) (rights eitherDirectives) -- Append each of the ONBUILD instructions return file where- toInstruction [(InstructionPos inst _ _)] = inst+ toInstruction [InstructionPos inst _ _] = inst toInstruction _ = error "This is not possible" -- | Extracts the list of instructions appearing in ONBUILD for a given docker history for a tag@@ -377,7 +402,7 @@ group (directive:rest) (current:prev) = group rest ((current ++ [directive]) : prev) -- Continue the currently open group -- -- | Returns true if the first element in the list is a FROM directive- startsWithFROM ((InstructionPos (From _) _ _):_) = True+ startsWithFROM (InstructionPos (From _) _ _:_) = True startsWithFROM _ = False -- | Converts a list of instructions into a Stage record
docker-build-cacher.cabal view
@@ -1,5 +1,5 @@ name: docker-build-cacher-version: 1.7.1+version: 1.8.0 synopsis: Builds a services with docker and caches all of its intermediate stages description: A CLI tool to speed up multi-stage docker file builds by caching intermediate stages separately, so the can be used in successive builds.