dockercook 0.4.3.0 → 0.5.0.0
raw patch · 19 files changed
+907/−198 lines, 19 filesdep +aesondep +aeson-prettydep +containersdep ~bytestringdep ~textdep ~unordered-containers
Dependencies added: aeson, aeson-pretty, containers, http-client
Dependency ranges changed: bytestring, text, unordered-containers
Files
- LICENSE +1/−1
- README.md +231/−0
- data/test1.cook +0/−32
- dockercook.cabal +20/−8
- src/lib/Cook/Build.hs +125/−32
- src/lib/Cook/BuildFile.hs +60/−26
- src/lib/Cook/DirectDocker.hs +198/−0
- src/lib/Cook/Docker.hs +2/−51
- src/lib/Cook/State/Manager.hs +83/−18
- src/lib/Cook/State/Model.hs +3/−1
- src/lib/Cook/Sync.hs +11/−9
- src/lib/Cook/Types.hs +11/−4
- src/prog/Cook/ArgParse.hs +49/−4
- src/prog/Main.hs +16/−3
- src/test/Tests.hs +1/−0
- src/test/Tests/BuildFile.hs +39/−9
- src/test/Tests/DirectDocker.hs +19/−0
- test/parsefail01.cook +6/−0
- test/parsefail02.cook +32/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014 factis research GmbH+Copyright (c) 2014-2015 factis research GmbH Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
+ README.md view
@@ -0,0 +1,231 @@+dockercook+=====++[](https://travis-ci.org/factisresearch/dockercook)++Build and manage multiple docker image layers to speed up deployment. For+a tutorial see below or the example directory.++# Install++Requirements: GHC7.8 and cabal or stack++* From Hackage: `cabal install dockercook`+* From Source: `git clone https://github.com/factisresearch/dockercook.git && cd dockercook && cabal install`+* From Source (stack): `git clone https://github.com/factisresearch/dockercook.git && cd dockercook && stack setup && stack install`++# Commands++```+Usage: dockercook [-v|--verbosity INT] COMMAND+ Speed up docker image building++Available options:+ -h,--help Show this help text+ -v,--verbosity INT log levels for 0 - 3++Available commands:+ cook Cook docker images+ check Validate a Dockercook file+ sync Sync local state with remote docker server+ version Show programs version+ timing Looking build times for image+ init Enable dockercook for current project / directory+```++# Cookfile Directives++## BASE COOK [cookfile]++Define the current cookfiles parent cookfile. You can only use this+directive once at the top and you can't use it in combination with `BASE+DOCKER [dockerimage]`.++## BASE DOCKER [dockerimage]++The cook-image will depend on an existing docker image. You can only use this+directive once at the top and you can't use it in combination with `BASE+DOCKER [dockerimage]`.++## INCLUDE [filepattern]++Include and depend on a file. You can use this anywhere in your cook file,+but it will be moved to the top before `UNPACK [target_dir]`.++## UNPACK [target_dir]++All included files will be unpacked to this directory. It will also ensure+that the directory exists. Requires a tar binary inside your+docker-container. You can only use this directive once.++## BEGIN++Begin a transaction. You can only put `SCRIPT [script]` and `RUN+[bash_cmd]` commands inside a transaction. All commands inside the+transaction will result in a single layer.++## COMMIT++Commit a transaction. This is only possible if you began a transaction ;-)++## SCRIPT [script]++Run a bash script and put it's result at the current position in the+dockerfile.++## DOWNLOAD [url] [filepath]++Download a file from `[url]` to `[filepath]` in your docker+container. The server must set one of the following headers and support+HEAD requests: Last-Modified, ETag, Content-MD5++## PREPARE [shell-command]++This shell command is executed in an empty directory and is useful to copy+additional files into the build context. Any file that you copy in the+working directory of the shell-command will be available in your cook file+from the `/_cookpreps` directory. All `PREPARE` commands in one file will be+executed in the same preparation directory. For more information check the+example.++## COOKCOPY [cookfile] [image-dir] [target-dir]++Copy a file or directory from an image described by `[cookfile]` to+`/_cookpreps/[target-dir]` in your current context. This can be very+useful for binary-only containers. Behind the scenes this starts the+image (entrypoint is set to `""`), uses `docker cp` to extract files and then kills the container.++## COOKVAR [var-name] [default-value]++This allows compile time environment variables. They can be set using `--set-var` (multiple times) with the `dockercook cook` command. The default value is optional. A `COOKVAR` directive is translated to dockers `ENV` command and populated with the correct value. If a `COOKVAR` does not have a default value and is not supplied via `--set-var` the build will fail.++## All Docker-Commands++Most other docker-commands are allowed in Cookfiles. `ADD` and `COPY`+commands are not recommended, as the dependencies aren't tracked. The+`FROM` command is not allowed.++# Emacs support++There's a basic `cookfile-mode.el` in the repository :-)++# Motivation / Tutorial++Consider the following Dockerfile for a sample nodejs project:++### Dockerfile+```+FROM ubuntu:14.04+RUN apt-get update+RUN apt-get install -y nodejs npm+RUN ln -s /usr/bin/nodejs /usr/bin/node+RUN mkdir /app+ADD package.json /app/package.json+WORKDIR /app+RUN npm install+ADD . /app+CMD node ./app.js +```++We have two branches for this nodejs project with the following `package.json`:++### Branch A: package.json+```+{+ "name": "sample-app",+ "version": "0.1.0",+ "dependencies" : {+ "bloomfilter" : "0.0.12",+ "express" : "2.1.x",+ "mongoose" : "2.2.x",+ "moment": "2.5.x"+ }+}+```++### Branch B: package.json+```+{+ "name": "sample-app",+ "version": "0.1.1",+ "dependencies" : {+ "bloomfilter" : "0.0.12",+ "express" : "3.4.x",+ "mongoose" : "3.6.x",+ "moment": "2.5.x",+ "request": "2.34.x"+ }+}+```++Building these two branches alternately on the same machine using docker and the Dockerfile above you'll notice the following behaviour:++* docker build branch A (from scratch)+* docker build branch B (starts at “ADD package.json /app”)+* docker build branch B (from cache)+* docker build branch A (starts at “ADD package.json /app”)+* docker build branch A (from cache)+* docker build branch B (starts at “ADD package.json /app”)++Lot's of time is wasted reinstalling the packages over and over again. (See: [Build caching: what invalids cache and not?](http://kimh.github.io/blog/en/docker/gotchas-in-writing-dockerfile-en/#build_caching_what_invalids_cache_and_not))++You can solve this by [building more efficient Dockerfiles](http://bitjudo.com/blog/2014/03/13/building-efficient-dockerfiles-node-dot-js/), but then you'd need two "package images" and two "app images" for your two branches and manage, delete and update these manually.++`dockercook` solves this issue by slicing the repository and managing those "intermediate" images for you. Back to our sample node js app, you would create three `cook` Files:++### system.cook+```+BASE DOCKER ubuntu:14.04+BEGIN+RUN apt-get update+RUN apt-get install -y nodejs npm+RUN apt-get clean+RUN ln -s /usr/bin/nodejs /usr/bin/node+COMMIT+```++### node-pkg.cook+```+BASE COOK system.cook+INCLUDE package.json+UNPACK /app+WORKDIR /app+RUN npm install+```++### app.cook+```+BASE COOK node-pkg.cook+INCLUDE *.js+UNPACK /app+CMD node ./app.js+```++Now you'd build your repository branches using `dockercook cook`:++```+$ cd $HOME/my-repo+$ dockercook init # only the first time+$ git checkout branchA+...+$ dockercook cook cookfiles/app.cook+...+$ cd $HOME/my-repo && git checkout branchB+...+$ dockercook cook cookfiles/app.cook+```+You'll notice the following behaviour:++* build branch A (builds: system + node-pkg + app)+* build branch B (builds: node-pkg’ + app’)+* build branch B (builds: app’)+* build branch A (builds: app)+* build branch A (builds: -)+* build branch B (builds: -)++Lot's of time is saved because you don't need to reinstall all your packages dependencies everytime you switch branches.++# Related work++* [docker-buildcache](https://github.com/baremetal/docker-buildcache)+
− data/test1.cook
@@ -1,32 +0,0 @@-BASE COOK 030_dev.cook--INCLUDE 3rdParty/*-INCLUDE scripts/sbt-INCLUDE scripts/sbt-launch-0.11.1.jar-INCLUDE build.sbt-INCLUDE project/build.properties -INCLUDE project/build.sbt -INCLUDE project/Build.scala-INCLUDE project/plugins.sbt-INCLUDE project/DbMetaSpec.scala -INCLUDE project/DbSpec.scala --UNPACK /DociData--# install binary dependencies-RUN apt-get install -y imagemagick--# dcmtk-RUN cd /tmp && wget -O dcmtk.tar.bz2 ftp://dicom.offis.de/pub/dicom/offis/software/dcmtk/dcmtk360/bin/dcmtk-3.6.0-linux-i686-static.tar.bz2-RUN cd /tmp && tar -xvf dcmtk.tar.bz2-RUN cp -R /tmp/dcmtk-3.6.0-linux-i686-static/* /usr/local/-RUN rm -rf /tmp/dcmtk*--# build DociData 3rdParty-WORKDIR /DociData-RUN wget -O /tmp/DociCache http://10.20.100.2/DociData-lib.tar.gz-RUN tar xzvf /tmp/DociCache -C .-RUN 3rdParty/build.sh--# build DociData dependencies-RUN scripts/sbt update
dockercook.cabal view
@@ -1,39 +1,45 @@ name: dockercook-version: 0.4.3.0+version: 0.5.0.0 synopsis: A build tool for multiple docker image layers description: Build and manage multiple docker image layers to speed up deployment license: MIT license-file: LICENSE author: Alexander Thiemann <thiemann@cp-med.com> maintainer: Alexander Thiemann <thiemann@cp-med.com>-copyright: (c) 2014 factis research GmbH+copyright: (c) 2014-2015 factis research GmbH category: Development build-type: Simple homepage: https://github.com/factisresearch/dockercook bug-reports: https://github.com/factisresearch/dockercook/issues cabal-version: >=1.8-data-dir: data-data-files: test1.cook+tested-with: GHC==7.8.3 +extra-source-files:+ test/*.cook+ README.md+ library hs-source-dirs: src/lib exposed-modules: Cook.Build, Cook.BuildFile,+ Cook.DirectDocker,+ Cook.Downloads, Cook.State.Manager, Cook.Sync, Cook.Types, Cook.Uploader,- Cook.Util,- Cook.Downloads+ Cook.Util other-modules: Cook.Docker, Cook.State.Model build-depends: attoparsec >=0.11,+ aeson >=0.8, base >=4.6 && <5, base16-bytestring >=0.1, bytestring >=0.10,+ containers >=0.5, conduit >=1.1, conduit-combinators >=0.2 && <1.0, conduit-extra >=1.1,@@ -42,6 +48,7 @@ filepath >=1.3, hashable >=1.2, hslogger >=1.2.6,+ http-client >=0.4.18.1, lens >=4.7, monad-logger >=0.3, mtl >=2.1,@@ -70,13 +77,17 @@ main-is: Main.hs other-modules: Cook.ArgParse build-depends:+ aeson-pretty >=0.7, base >=4.6 && <5,+ bytestring, directory, dockercook, filepath, hslogger, optparse-applicative >=0.11.0.1,- process+ process,+ text,+ unordered-containers hs-source-dirs: src/prog ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures @@ -84,7 +95,8 @@ type: exitcode-stdio-1.0 hs-source-dirs: src/test main-is: Tests.hs- other-modules: Tests.BuildFile+ other-modules: Tests.BuildFile,+ Tests.DirectDocker build-depends: HTF >=0.12.2.3, base >=4.6 && <5,
src/lib/Cook/Build.hs view
@@ -13,6 +13,7 @@ import Cook.Util import Cook.Downloads import qualified Cook.Docker as D+import qualified Cook.DirectDocker as Docker import Control.Applicative import Control.Monad@@ -20,7 +21,9 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (runResourceT, MonadResource) import Data.Conduit-import Data.Maybe (fromMaybe, isJust)+import Data.Maybe (fromMaybe, isJust, catMaybes)+import Data.Monoid+import Data.Time (getCurrentTime, diffUTCTime) import System.Directory import System.Exit import System.FilePath@@ -117,6 +120,10 @@ liftIO $ hPutStr stderr "." return $ Just (relToCurrentF, hash) +runPrepareCommands ::+ FilePath -> FilePath -> BuildFile -> (BSC.ByteString -> IO ())+ -> [(DockerImage, [(FilePath, FilePath)])]+ -> IO (Maybe FilePath, IO (), SHA1) runPrepareCommands tempDir prepareDir bf streamHook cookCopyHm = do logDebug "Running PREPARE commands" let outTar = "_dc_prepared.tar.gz"@@ -147,15 +154,21 @@ logDebug ("PREPARE: Hashing " ++ show fp) return $ [quickHash bs] -buildImage :: FilePath- -> D.DockerImagesCache- -> Maybe StreamHook- -> CookConfig- -> StateManager- -> HashManager- -> [(FP.FilePath, SHA1)]- -> Uploader -> (BuildFile, FilePath) -> IO DockerImage-buildImage rootDir imCache mStreamHook cfg@(CookConfig{..}) stateManager hashManager fileHashes uploader (bf, bfRootDir) =+data BuildEnv+ = BuildEnv+ { be_hostInfo :: Docker.DockerInfo+ , be_rootDir :: FilePath+ , be_imCache :: Docker.DockerImagesCache+ , be_streamHook :: Maybe StreamHook+ , be_config :: CookConfig+ , be_stateManager :: StateManager+ , be_hashManager :: HashManager+ , be_fileHashes :: [(FP.FilePath, SHA1)]+ , be_uploader :: Uploader+ }++buildImage :: BuildEnv -> (BuildFile, FilePath) -> IO DockerImage+buildImage env (bf, bfRootDir) = withSystemTempDirectory "cookbuildXXX" $ \buildTempDir -> withSystemTempDirectory "cookprepareXXX" $ \prepareDir -> do logDebug $ "Inspecting " ++ name ++ "..."@@ -163,29 +176,53 @@ case bf_base bf of (BuildBaseCook parentBuildFile) -> do parent <- prepareEntryPoint $ buildFileIdAddParent bfRootDir parentBuildFile- buildImage rootDir imCache mStreamHook cfg stateManager hashManager fileHashes uploader (parent, bfRootDir)+ buildImage env (parent, bfRootDir) (BuildBaseDocker rootImage) -> do baseExists <- dockerImageExists rootImage if baseExists- then do markUsingImage stateManager rootImage+ then do markUsingImage (be_stateManager env) rootImage (Docker.di_id hostInfo) return rootImage else do hPutStrLn stderr $ "Downloading the docker root image " ++ show (unDockerImage rootImage) ++ "... " (ec, stdOut, stdErr) <- readProcessWithExitCode "docker" ["pull", T.unpack $ unDockerImage rootImage] "" if ec == ExitSuccess- then do markUsingImage stateManager rootImage+ then do markUsingImage (be_stateManager env) rootImage (Docker.di_id hostInfo) return rootImage else error ("Can't find provided base docker image " ++ (show $ unDockerImage rootImage) ++ ": " ++ stdOut ++ "\n" ++ stdErr)+ baseDockerId <-+ case bf_base bf of+ BuildBaseDocker rootImage ->+ do mImageId <- Docker.dockerImageId rootImage+ case mImageId of+ Nothing ->+ error ("Failed to get image id of " ++ (show $ unDockerImage rootImage))+ Just i -> return $ Just (T.encodeUtf8 $ unDockerImageId i)+ _ -> return Nothing (dockerCommandsBase, txHashes) <- buildTxScripts buildTempDir bf cookCopyHm <- forM (HM.toList $ bf_cookCopy bf) $ \(cookFile, files) -> do cookPrep <- prepareEntryPoint (buildFileIdAddParent bfRootDir $ BuildFileId $ T.pack cookFile)- image <- buildImage rootDir imCache mStreamHook cfg stateManager hashManager fileHashes uploader (cookPrep, bfRootDir)+ image <- buildImage env (cookPrep, bfRootDir) return (image, files) (mTar, mkPrepareTar, prepareHash) <- runPrepareCommands buildTempDir prepareDir bf streamHook cookCopyHm downloadHashes <- mapM getUrlHash (V.toList $ bf_downloadDeps bf)+ envVarCommands <-+ flip V.mapM (bf_requiredVars bf) $ \(var, maybeDefault) ->+ do varVal <-+ case HM.lookup var cc_compileVars of+ Nothing ->+ case maybeDefault of+ Nothing ->+ fail ("Image " ++ (T.unpack $ unBuildFileId $ bf_name bf)+ ++ " required env var " ++ T.unpack var ++ ", but "+ ++ "it is not defined and no default is provided!")+ Just defVal ->+ return defVal+ Just val ->+ return val+ return $ DockerCommand "ENV" (var <> " " <> varVal) let (copyPreparedTar, cleanupCmds) = case mTar of Just preparedTar ->@@ -203,12 +240,22 @@ (Just target, _) -> copyTarAndUnpack SkipExisting "context.tar.gz" target dockerCommands =- V.concat [contextAdd, copyPreparedTar, dockerCommandsBase, cleanupCmds]+ V.concat+ [ contextAdd+ , copyPreparedTar+ , envVarCommands+ , dockerCommandsBase+ , cleanupCmds+ ] dockerBS = BSC.concat [ "FROM ", T.encodeUtf8 (unDockerImage baseImage), "\n" , T.encodeUtf8 $ T.unlines $ V.toList $ V.map dockerCmdToText dockerCommands ]- dockerHash = quickHash [dockerBS]+ dockerHash =+ quickHash $ catMaybes+ [ Just dockerBS+ , baseDockerId+ ] allFHashes = map snd targetedFiles buildFileHash = quickHash [BSC.pack (show $ bf { bf_name = BuildFileId "static" })] superHash =@@ -225,7 +272,7 @@ fmap (\prefix -> prefix ++ drop cc_cookFileDropCount name) cc_tagprefix markImage :: IO (Maybe DockerImage) markImage =- do markUsingImage stateManager imageName+ do markUsingImage (be_stateManager env) imageName (Docker.di_id hostInfo) T.forM mUserTagName $ \userTag -> do _ <- systemStream Nothing ("docker tag -f " ++ imageTag ++ " " ++ userTag) streamHook return (DockerImage $ T.pack userTag)@@ -253,13 +300,14 @@ ) unless (cc_forceRebuild) $ logDebug' "Image not found!" mkPrepareTar- x <- launchImageBuilder dockerBS imageName buildTempDir+ (x, buildTime) <- launchImageBuilder dockerBS imageName buildTempDir mTag <- markImage+ setImageBuildTime (be_stateManager env) imageName (Docker.di_id hostInfo) buildTime announceBegin- hPutStrLn stderr ("built " ++ nameTagArrow)+ hPutStrLn stderr ("built " ++ nameTagArrow ++ " (" ++ show buildTime ++ ")") withRawImageId imageName $ \imageId -> do logDebug' $ "The raw id of " ++ imageTag ++ " is " ++ show imageId- setImageId stateManager imageName imageId+ setImageId (be_stateManager env) imageName imageId return (mTag, x) when (cc_autoPush) $ case mNewTag of@@ -271,8 +319,14 @@ enqueueImage uploader newTag return newImage where+ (CookConfig{..}) = be_config env+ hostInfo = be_hostInfo env+ imCache = be_imCache env+ rootDir = be_rootDir env+ uploader = be_uploader env+ mStreamHook = be_streamHook env withRawImageId imageName action =- do mImageId <- D.getImageId imageName+ do mImageId <- Docker.dockerInspectImage imageName case mImageId of Nothing -> do let errorMsg =@@ -280,7 +334,7 @@ ++ ". Did you run dockercook sync?" logWarn errorMsg error errorMsg- Just imageId -> action imageId+ Just imageInfo -> action (Docker.dii_id imageInfo) name = dropExtension $ takeFileName $ T.unpack $ unBuildFileId $ bf_name bf logDebug' m = do logDebug m@@ -295,24 +349,35 @@ Just (StreamHook hook) -> hook bs dockerImageExists localIm@(DockerImage imageName) = do logDebug' $ "Checking if the image " ++ show imageName ++ " is already present... "- known <- isImageKnown stateManager localIm- mRawImageId <- getImageId stateManager localIm+ known <-+ do locallyKnown <- isImageKnown (be_stateManager env) localIm (Docker.di_id hostInfo)+ if locallyKnown+ then do remotelyKnown <- Docker.doesImageExist imCache (Left localIm)+ unless remotelyKnown $+ do logInfo $+ "My local state is not up to date with the remote host. "+ ++ "Forgetting " ++ show imageName+ ++ " for now and rebuilding it."+ forgetImage (be_stateManager env) localIm (Docker.di_id hostInfo)+ return remotelyKnown+ else return False+ mRawImageId <- getImageId (be_stateManager env) localIm (Docker.di_id hostInfo) let storeRawId = unless (isJust mRawImageId) $ withRawImageId localIm $ \imageId -> do logDebug' $ "The raw id of " ++ (T.unpack imageName) ++ " is " ++ show imageId- setImageId stateManager localIm imageId+ setImageId (be_stateManager env) localIm imageId if known then do logDebug' $ "Image " ++ show imageName ++ " is registered in your state directory. Assuming it is present!" storeRawId return True- else do taggedExists <- D.doesImageExist imCache (Left localIm)+ else do taggedExists <- Docker.doesImageExist imCache (Left localIm) case (taggedExists, mRawImageId) of (True, _) -> do storeRawId return True (False, Just rawId) ->- do rawExists <- D.doesImageExist imCache (Right rawId)+ do rawExists <- Docker.doesImageExist imCache (Right rawId) when rawExists $ D.tagImage rawId localIm return rawExists@@ -327,7 +392,7 @@ currentDir <- getCurrentDirectory let includedFilesFull = map (FP.encodeString . fst) targetedFiles forM_ includedFilesFull $ \f ->- do didChange <- (hm_didFileChange hashManager) (currentDir </> f)+ do didChange <- (hm_didFileChange $ be_hashManager env) (currentDir </> f) when didChange $ fail $ "Inconsistency error: File " ++ f ++ " changed during build!" True ->@@ -346,9 +411,11 @@ BS.writeFile (tempDir </> "Dockerfile") dockerBS logDebug' ("Building " ++ name ++ "...") let tag = T.unpack $ unDockerImage imageName+ started <- getCurrentTime ecDocker <- systemStream Nothing ("docker build --no-cache --force-rm --rm -t " ++ tag ++ " " ++ tempDir) streamHook if ecDocker == ExitSuccess- then return imageName+ then do finished <- getCurrentTime+ return (imageName, finished `diffUTCTime` started) else do hPutStrLn stderr ("Failed to build " ++ tag ++ "!") hPutStrLn stderr ("Failing Cookfile: " ++ T.unpack (unBuildFileId (bf_name bf)))@@ -361,7 +428,7 @@ Just x -> x matchesFile fp pattern = matchesFilePattern pattern (FP.encodeString (localName fp)) isNeededHash fp = or (map (matchesFile fp) (V.toList (bf_include bf)))- targetedFiles = filter (\(fp, _) -> isNeededHash fp) fileHashes+ targetedFiles = filter (\(fp, _) -> isNeededHash fp) (be_fileHashes env) cookBuild :: FilePath -> FilePath -> CookConfig -> Uploader -> Maybe StreamHook -> IO [DockerImage]@@ -374,8 +441,34 @@ (,) <$> (prepareEntryPoint . BuildFileId . T.pack) entryPointFile <*> return (takeDirectory entryPointFile) ) cc_buildEntryPoints- imCache <- D.newDockerImagesCache- res <- mapM (buildImage rootDir imCache mStreamHook cfg stateManager hashManager fileHashes uploader) roots+ hostInfo <-+ do di <- Docker.dockerInfo+ case di of+ Nothing ->+ error "docker info failed! Are you connected to a docker host?"+ Just info -> return info+ logInfo ("Builds will be run on " ++ (T.unpack $ Docker.di_name hostInfo))+ let envVarInfo =+ if HM.null cc_compileVars+ then "none"+ else T.unpack $+ T.intercalate "; " $+ map (\(k,v) -> k <> "=" <> v) $ HM.toList cc_compileVars+ logInfo ("Defined compile time environment variables are: " ++ envVarInfo)+ imCache <- Docker.newDockerImagesCache+ let buildEnv =+ BuildEnv+ { be_hostInfo = hostInfo+ , be_rootDir = rootDir+ , be_imCache = imCache+ , be_streamHook = mStreamHook+ , be_config = cfg+ , be_stateManager = stateManager+ , be_hashManager = hashManager+ , be_fileHashes = fileHashes+ , be_uploader = uploader+ }+ res <- mapM (buildImage buildEnv) roots waitForWrites stateManager logInfo "Finished building all required images!" return res
src/lib/Cook/BuildFile.hs view
@@ -10,7 +10,7 @@ , FilePattern, matchesFilePattern, parseFilePattern , UnpackMode(..) -- don't use - only exported for testing- , parseBuildFileText+ , parseBuildFileText, emptyBuildFile ) where @@ -58,6 +58,7 @@ , bf_downloadDeps :: V.Vector DownloadUrl , bf_transactions :: HM.HashMap TxRef (V.Vector T.Text) , bf_cookCopy :: HM.HashMap FilePath [(FilePath, FilePath)]+ , bf_requiredVars :: V.Vector (T.Text, Maybe T.Text) } deriving (Show, Eq) data BuildBase@@ -66,16 +67,26 @@ deriving (Show, Eq) data BuildFileLine- = IncludeLine FilePattern -- copy files from data directory to temporary cook directory- | BaseLine BuildBase -- use either cook file or docker image as base- | PrepareLine T.Text -- run shell command in temporary cook directory- | UnpackLine FilePath -- where should the context be unpacked to?- | ScriptLine FilePath (Maybe T.Text) -- execute a script in cook directory to generate more cook commands+ = IncludeLine FilePattern+ -- ^ copy files from data directory to temporary cook directory+ | BaseLine BuildBase+ -- ^ use either cook file or docker image as base+ | PrepareLine T.Text+ -- ^ run shell command in temporary cook directory+ | UnpackLine FilePath+ -- ^ where should the context be unpacked to?+ | ScriptLine FilePath (Maybe T.Text)+ -- ^ execute a script in cook directory to generate more cook commands | BeginTxLine | CommitTxLine- | DownloadLine DownloadUrl FilePath -- download a file to a location- | CookCopyLine FilePath FilePath FilePath -- copy a file or folder from a cook-image to the _cookprep folder- | DockerLine DockerCommand -- regular docker command+ | DownloadLine DownloadUrl FilePath+ -- ^ download a file to a location+ | CookCopyLine FilePath FilePath FilePath+ -- ^ copy a file or folder from a cook-image to the _cookprep folder+ | RequireEnvVarLine (T.Text, Maybe T.Text)+ -- ^ require a compile time environment variable with an optional default+ | DockerLine DockerCommand+ -- ^ regular docker command deriving (Show, Eq) data DockerCommand@@ -123,7 +134,8 @@ withSystemTempDirectory "cooktx" $ \txDir -> do let dirName = T.unpack $ T.decodeUtf8 $ B16.encode $ unSha1 $- quickHash $ map T.encodeUtf8 $ V.toList $ V.concat $ HM.elems $ bf_transactions bf+ quickHash $ map T.encodeUtf8 $ V.toList $ V.concat $ HM.elems $+ bf_transactions bf txSh <- forM (HM.toList (bf_transactions bf)) $ \(TxRef refId, actions) -> do let f = "tx_" ++ show refId ++ ".sh"@@ -151,7 +163,8 @@ mkTxLine dirName l = case l of Left (TxRef refId) ->- DockerCommand "RUN" (T.pack $ "bash " ++ (dockerTarDir dirName </> "tx_" ++ show refId ++ ".sh"))+ DockerCommand "RUN" (T.pack $ "bash "+ ++ (dockerTarDir dirName </> "tx_" ++ show refId ++ ".sh")) Right cmd -> cmd pre dirName = V.fromList (copyTarAndUnpack OverwriteExisting "tx.tar.gz" (dockerTarDir dirName))@@ -164,7 +177,8 @@ mkScript txId scriptLines = T.unlines ("#!/bin/bash" : "# auto generated by dockercook" : (T.pack $ "echo 'DockercookTx # " ++ show txId ++ "'")- : "set -e" : "set -x" : (map (\ln -> T.concat ["( ", ln, " )"]) $ V.toList scriptLines)+ : "set -e" : "set -x"+ : (map (\ln -> T.concat ["( ", ln, " )"]) $ V.toList scriptLines) ) data UnpackMode@@ -185,27 +199,30 @@ ++ " && rm -rf /" ++ tarName ] +emptyBuildFile :: BuildFileId -> BuildBase -> BuildFile+emptyBuildFile myId base =+ BuildFile+ { bf_name = myId+ , bf_base = base+ , bf_unpackTarget = Nothing+ , bf_dockerCommands = V.empty+ , bf_include = V.empty+ , bf_prepare = V.empty+ , bf_downloadDeps = V.empty+ , bf_transactions = HM.empty+ , bf_cookCopy = HM.empty+ , bf_requiredVars = V.empty+ } + constructBuildFile :: FilePath -> FilePath -> [BuildFileLine] -> IO (Either String BuildFile) constructBuildFile cookDir fp theLines = case baseLine of Just (BaseLine base) ->- baseCheck base $ handleLine (Right (initBuildFile base)) Nothing theLines+ baseCheck base $ handleLine (Right (emptyBuildFile myId base)) Nothing theLines _ -> return $ Left "Missing BASE line!" where- initBuildFile base =- BuildFile- { bf_name = myId- , bf_base = base- , bf_unpackTarget = Nothing- , bf_dockerCommands = V.empty- , bf_include = V.empty- , bf_prepare = V.empty- , bf_downloadDeps = V.empty- , bf_transactions = HM.empty- , bf_cookCopy = HM.empty- } checkDocker (DockerCommand cmd _) action = let lowerCmd = T.toLower cmd in case lowerCmd of@@ -271,6 +288,13 @@ (Just nextTxId) rest CommitTxLine -> return $ Left "COMMIT is missing a BEGIN!"+ RequireEnvVarLine var ->+ handleLine+ (Right $ buildFile+ { bf_requiredVars = V.snoc (bf_requiredVars buildFile) var+ }+ )+ inTx rest _ -> handleLine mBuildFile inTx rest cookCopyLine cookFile containerPath hostPath buildFile =@@ -340,7 +364,7 @@ finish = pComment *> ((() <$ many endOfLine) <|> endOfInput) lineP =- (many (pComment <* endOfLine)) *> lineP'+ (many (pComment <* endOfLine)) *> (skipSpace *> lineP') lineP' = IncludeLine <$> (pIncludeLine <* finish) <|> BaseLine <$> (pBuildBase <* finish) <|>@@ -351,7 +375,17 @@ CommitTxLine <$ (pCommitTx <* finish) <|> (pDownloadLine <* finish) <|> (pCookCopyLine <* finish) <|>+ RequireEnvVarLine <$> (pCookVar <* finish) <|> DockerLine <$> (pDockerCommand <* finish)++pCookVar :: Parser (T.Text, Maybe T.Text)+pCookVar =+ asciiCI "COOKVAR" *> skipSpace *> valP <* skipSpace+ where+ valP =+ (,)+ <$> (takeWhile1 (\x -> isAlphaNum x || x == '_'))+ <*> (optional $ T.strip <$> takeWhile1 (not . eolOrComment)) pBeginTx :: Parser () pBeginTx = asciiCI "BEGIN" *> skipSpace
+ src/lib/Cook/DirectDocker.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Cook.DirectDocker+ ( DockerHostId(..), dockerHostIdAsText+ , dockerInfo, DockerInfo(..)+ , dockerImageId, dockerInspectImage, DockerImageInfo(..)+ , dockerImages, DockerImageListInfo(..)+ , newDockerImagesCache, doesImageExist, DockerImagesCache(..)+ , DockerTag(..), DockerTagVersion(..), parseDockerTag+ )+where++import Cook.Types+import Cook.Util++import Control.Applicative+import Control.Concurrent.STM+import Control.Exception+import Control.Lens ((^?))+import Control.Monad+import Data.Aeson+import Data.Char (isDigit)+import Data.List (foldl')+import Data.Monoid+import Network.HTTP.Client (HttpException(..))+import Network.Wreq+import System.Environment+import qualified Data.Set as S+import qualified Data.Text as T++newtype DockerBaseUrl+ = DockerBaseUrl { _unDockerBaseUrl :: T.Text }+ deriving (Show, Eq)++newtype DockerHostId+ = DockerHostId { unDockerHostId :: T.Text }+ deriving (Show, Eq, FromJSON, ToJSON)++dockerHostIdAsText :: DockerHostId -> T.Text+dockerHostIdAsText = unDockerHostId++data DockerTag+ = DockerTag+ { dt_name :: !T.Text+ , dt_version :: !DockerTagVersion+ } deriving (Show, Eq, Ord)++data DockerTagVersion+ = DockerTagVersionLatest+ | DockerTagVersionNone+ | DockerTagVersionOther !T.Text+ deriving (Show, Eq, Ord)++parseDockerTag :: T.Text -> DockerTag+parseDockerTag rawTag =+ DockerTag+ { dt_name = host+ , dt_version =+ case tag of+ "" -> DockerTagVersionLatest+ "latest" -> DockerTagVersionLatest+ "<none>" -> DockerTagVersionNone+ xs -> DockerTagVersionOther xs+ }+ where+ (host, tag) =+ if T.isInfixOf "/" tag' && T.length (T.takeWhile isDigit tag') >= 2+ then (host' <> ":" <> tag', "")+ else (host', tag')+ (host', tag') =+ if T.isInfixOf ":" rawTag+ then let (a, b) = T.breakOn ":" (T.reverse rawTag)+ in (T.take (T.length b - 1) $ T.reverse b, T.reverse a)+ else (rawTag, "")++instance FromJSON DockerTag where+ parseJSON =+ withText "DockerTag" $ \str ->+ pure $ parseDockerTag str++data DockerInfo+ = DockerInfo+ { di_id :: !DockerHostId+ , di_name :: !T.Text+ } deriving (Show, Eq)++instance FromJSON DockerInfo where+ parseJSON =+ withObject "DockerInfo" $ \obj ->+ DockerInfo+ <$> obj .: "ID"+ <*> obj .: "Name"++data DockerImageInfo+ = DockerImageInfo+ { dii_id :: !DockerImageId+ , dii_size :: !Int+ , dii_virtualSize :: !Int+ } deriving (Show, Eq)++instance FromJSON DockerImageInfo where+ parseJSON =+ withObject "DockerImageInfo" $ \obj ->+ DockerImageInfo+ <$> obj .: "Id"+ <*> obj .: "Size"+ <*> obj .: "VirtualSize"++data DockerImageListInfo+ = DockerImageListInfo+ { dili_id :: !DockerImageId+ , dili_parentId :: !DockerImageId+ , dili_size :: !Int+ , dili_virtualSize :: !Int+ , dili_repoTags :: [DockerTag]+ } deriving (Show, Eq)++instance FromJSON DockerImageListInfo where+ parseJSON =+ withObject "DockerImageListInfo" $ \obj ->+ DockerImageListInfo+ <$> obj .: "Id"+ <*> obj .: "ParentId"+ <*> obj .: "Size"+ <*> obj .: "VirtualSize"+ <*> obj .: "RepoTags"++withDockerBaseUrl :: (DockerBaseUrl -> IO a) -> IO a+withDockerBaseUrl action =+ do host <- getEnv "DOCKER_HOST"+ action $ DockerBaseUrl $ T.replace "tcp://" "http://" (T.pack host) <> "/v1.19/"++-- | Retrieve information about the remote docker host+dockerInfo :: IO (Maybe DockerInfo)+dockerInfo =+ withDockerBaseUrl $ \(DockerBaseUrl url) ->+ do r <- asJSON =<< get (T.unpack url <> "info")+ return (r ^? responseBody)++-- | Get the image id providing an image tag+dockerImageId :: DockerImage -> IO (Maybe DockerImageId)+dockerImageId di = liftM (fmap dii_id) $ dockerInspectImage di++-- | Looking information about an image provided an image tag+dockerInspectImage :: DockerImage -> IO (Maybe DockerImageInfo)+dockerInspectImage (DockerImage name) =+ action `catch` \(_ :: HttpException) -> return Nothing+ where+ action =+ withDockerBaseUrl $ \(DockerBaseUrl url) ->+ do r <- asJSON =<< get (T.unpack url <> "images/" <> T.unpack name <> "/json")+ return (r ^? responseBody)++-- | List docker images on remote docker host+dockerImages :: IO (Maybe [DockerImageListInfo])+dockerImages =+ withDockerBaseUrl $ \(DockerBaseUrl url) ->+ do r <- asJSON =<< get (T.unpack url <> "images/json?all=0")+ return (r ^? responseBody)++newtype DockerImagesCache+ = DockerImagesCache { unDockerImagesCache :: TVar (Maybe (S.Set DockerTag, S.Set DockerImageId)) }++-- | Create new cache for 'doesImageExist'+newDockerImagesCache :: IO DockerImagesCache+newDockerImagesCache =+ DockerImagesCache <$> newTVarIO Nothing++-- | Check if an image exists on remote docker host+doesImageExist :: DockerImagesCache -> Either DockerImage DockerImageId -> IO Bool+doesImageExist (DockerImagesCache cacheVar) eImage =+ do cacheData <-+ do cd <- atomically $ readTVar cacheVar+ case cd of+ Nothing ->+ do logDebug "No image cache available, hitting server to get a list"+ res <- dockerImages+ case res of+ Nothing ->+ error "Docker images failed!"+ Just imageList ->+ do let cacheState =+ foldl' (\(tags, ids) img ->+ ( S.fromList (dili_repoTags img) `S.union` tags+ , S.insert (dili_id img) ids+ )+ ) (S.empty, S.empty) imageList+ atomically $ writeTVar cacheVar (Just cacheState)+ return cacheState+ Just d -> return d+ return $ doLookup cacheData+ where+ doLookup (tagSet, imageIdSet) =+ case eImage of+ Left (DockerImage n) ->+ S.member (parseDockerTag n) tagSet+ Right n -> S.member n imageIdSet
src/lib/Cook/Docker.hs view
@@ -1,36 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DoAndIfThenElse #-} module Cook.Docker- ( DockerImagesCache, newDockerImagesCache- , dockerReachable, doesImageExist+ ( dockerReachable , DockerContainer , dockerRunForCopy, dockerRm, dockerCp- , getImageId, tagImage+ , tagImage ) where import Cook.Types import Cook.Util -import Control.Applicative-import Control.Concurrent.STM import System.Exit import qualified Data.Text as T -newtype DockerImagesCache- = DockerImagesCache { _unDockerImagesCache :: TVar (Maybe T.Text) }- data DockerContainer = DockerContainer { unDockerContainer :: T.Text } deriving (Show, Eq) -getImageId :: DockerImage -> IO (Maybe DockerImageId)-getImageId (DockerImage imageName) =- do (ec, stdOut, _) <- readProcessWithExitCode' "docker" ["inspect", "-f", "{{.Id}}", T.unpack imageName] ""- if ec /= ExitSuccess- then return Nothing- else return $ Just $ DockerImageId $ T.strip $ T.pack stdOut- tagImage :: DockerImageId -> DockerImage -> IO () tagImage (DockerImageId imageId) (DockerImage imageTag) = do (ec, _, _) <- readProcessWithExitCode' "docker" ["tag", "-f", T.unpack imageId, T.unpack imageTag] ""@@ -72,39 +59,3 @@ if ec /= ExitSuccess then fail $ "Failed to cp from container " ++ cid ++ ": " ++ stderr else return ()--newDockerImagesCache :: IO DockerImagesCache-newDockerImagesCache =- DockerImagesCache <$> newTVarIO Nothing--doesImageExist :: DockerImagesCache -> Either DockerImage DockerImageId -> IO Bool-doesImageExist (DockerImagesCache cacheVar) eImage =- do mOut <- atomically $ readTVar cacheVar- (ec, imageText) <-- case mOut of- Just textOut ->- do logDebug "Using cached docker images for doesImageExist"- return (ExitSuccess, textOut)- Nothing ->- do logDebug "Using live docker images for doesImageExist"- (ecL, stdOut, _) <- readProcessWithExitCode' "docker" ["images"] ""- let textOut = T.pack stdOut- atomically $ writeTVar cacheVar (Just textOut)- return (ecL, textOut)- let imageLines = T.lines imageText- return $ ec == ExitSuccess && checkLines imageName imageLines- where- imageName =- case eImage of- Left (DockerImage n) -> n- Right (DockerImageId n) -> n- checkLines _ [] = False- checkLines im (line:xs) =- let (imageBaseName, vers) = T.break (==':') im- in if T.isPrefixOf imageBaseName line- then if vers == ""- then True- else if T.isInfixOf (T.drop 1 vers) line- then True- else checkLines im xs- else checkLines im xs
src/lib/Cook/State/Manager.hs view
@@ -6,9 +6,11 @@ module Cook.State.Manager ( StateManager, HashManager(..) , createStateManager, markUsingImage+ , forgetImage , isImageKnown, fastFileHash , syncImages, waitForWrites- , getImageId, setImageId+ , getImageId, setImageId, setImageBuildTime+ , ImageBuildTime(..), getImageBuildTime , _STATE_DIR_NAME_, findStateDirectory ) where@@ -16,7 +18,7 @@ import Cook.Util import Cook.State.Model import Cook.Types-import qualified Cook.Docker as D+import qualified Cook.DirectDocker as Docker import Control.Applicative import Control.Concurrent@@ -27,8 +29,9 @@ import Control.Monad.State import Control.Monad.Trans.Resource import Control.Retry+import Data.Aeson import Data.Maybe-import Data.Time.Clock+import Data.Time import Data.Time.Clock.POSIX import Database.Persist.Sqlite import System.Directory@@ -55,7 +58,8 @@ fastFileHash :: forall m. MonadIO m => HashManager -> FilePath -> m SHA1 -> m SHA1 fastFileHash hm = hm_lookup hm -_STATE_DIR_NAME_ = ".kitchen"+_STATE_DIR_NAME_ :: FilePath+_STATE_DIR_NAME_ = ".kitchen2" findStateDirectory :: IO FilePath findStateDirectory =@@ -224,15 +228,16 @@ Nothing -> recomputeHash -syncImages :: StateManager -> (DockerImage -> IO Bool) -> IO ()-syncImages sm@(StateManager{..}) imageStillExists =- do x <- sm_runSqlGet $ selectList [] []+syncImages :: StateManager -> Docker.DockerHostId -> (DockerImage -> IO Bool) -> IO ()+syncImages sm@(StateManager{..}) dh imageStillExists =+ do let hostId = Docker.dockerHostIdAsText dh+ x <- sm_runSqlGet $ selectList [DbDockerImageHost ==. hostId] [] forM_ x $ \entity -> do let dockerImage = entityVal entity name = dbDockerImageName dockerImage exists <- imageStillExists (DockerImage name) if exists- then do mRawId <- D.getImageId (DockerImage name)+ then do mRawId <- Docker.dockerImageId (DockerImage name) case mRawId of Nothing -> do logInfo ("The image " ++ T.unpack name@@ -246,14 +251,19 @@ sm_runSqlWrite $ delete (entityKey entity) sm_waitForWrites -isImageKnown :: StateManager -> DockerImage -> IO Bool-isImageKnown (StateManager{..}) (DockerImage imageName) =- do x <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName)+isImageKnown :: StateManager -> DockerImage -> Docker.DockerHostId -> IO Bool+isImageKnown (StateManager{..}) (DockerImage imageName) dh =+ do x <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName $ Docker.dockerHostIdAsText dh) return (isJust x) -getImageId :: StateManager -> DockerImage -> IO (Maybe DockerImageId)-getImageId (StateManager{..}) (DockerImage imageName) =- do x <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName)+forgetImage :: StateManager -> DockerImage -> Docker.DockerHostId -> IO ()+forgetImage (StateManager{..}) (DockerImage imageName) dh =+ do sm_runSqlWrite $ deleteBy (UniqueDbDockerImage imageName $ Docker.dockerHostIdAsText dh)+ sm_waitForWrites++getImageId :: StateManager -> DockerImage -> Docker.DockerHostId -> IO (Maybe DockerImageId)+getImageId (StateManager{..}) (DockerImage imageName) dh =+ do x <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName $ Docker.dockerHostIdAsText dh) case x of Nothing -> return Nothing Just entity ->@@ -263,16 +273,71 @@ setImageId (StateManager{..}) (DockerImage imageName) (DockerImageId imageId) = sm_runSqlWrite $ updateWhere [ DbDockerImageName ==. imageName ] [ DbDockerImageRawImageId =. (Just imageId) ] -markUsingImage :: StateManager -> DockerImage -> IO ()-markUsingImage (StateManager{..}) (DockerImage imageName) =- do mImageEntity <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName)+setImageBuildTime :: StateManager -> DockerImage -> Docker.DockerHostId -> NominalDiffTime -> IO ()+setImageBuildTime (StateManager{..}) (DockerImage imageName) dh t =+ sm_runSqlWrite $+ updateWhere+ [ DbDockerImageName ==. imageName+ , DbDockerImageHost ==. (Docker.dockerHostIdAsText dh)+ ] [ DbDockerImageBuildTimeSeconds =. (fromRational $ toRational t) ]++markUsingImage :: StateManager -> DockerImage -> Docker.DockerHostId -> IO ()+markUsingImage (StateManager{..}) (DockerImage imageName) dh =+ do let hostId = Docker.dockerHostIdAsText dh+ mImageEntity <- sm_runSqlGet $ getBy (UniqueDbDockerImage imageName hostId) now <- getCurrentTime case mImageEntity of Nothing -> sm_runSqlWrite $- do _ <- insert $ DbDockerImage imageName Nothing now now 1+ do _ <-+ insert $+ DbDockerImage+ { dbDockerImageHost = hostId+ , dbDockerImageName = imageName+ , dbDockerImageRawImageId = Nothing+ , dbDockerImageCreationDate = now+ , dbDockerImageLastUsed = now+ , dbDockerImageUsageCount = 1+ , dbDockerImageBuildTimeSeconds = 0+ } return () Just imageEntity -> sm_runSqlGet $ update (entityKey imageEntity) [ DbDockerImageUsageCount +=. 1 , DbDockerImageLastUsed =. now ]++data ImageBuildTime+ = ImageBuildTime+ { ibt_host :: !Docker.DockerHostId+ , ibt_imageId :: !(Maybe DockerImageId)+ , ibt_cookId :: !DockerImage+ , ibt_seconds :: !Double+ } deriving (Show, Eq)++instance ToJSON ImageBuildTime where+ toJSON ibt =+ object+ [ "host" .= ibt_host ibt+ , "imageId" .= ibt_imageId ibt+ , "cookId" .= ibt_cookId ibt+ , "seconds" .= ibt_seconds ibt+ ]++getImageBuildTime :: StateManager -> Either DockerImage DockerImageId -> IO [ImageBuildTime]+getImageBuildTime (StateManager{..}) search =+ do res <- sm_runSqlGet $ selectList filters []+ return $ map transTime res+ where+ transTime entity =+ ImageBuildTime+ { ibt_host = Docker.DockerHostId (dbDockerImageHost val)+ , ibt_imageId = fmap DockerImageId (dbDockerImageRawImageId val)+ , ibt_cookId = DockerImage (dbDockerImageName val)+ , ibt_seconds = dbDockerImageBuildTimeSeconds val+ }+ where+ val = entityVal entity+ filters =+ case search of+ Left (DockerImage cookImage) -> [ DbDockerImageName ==. cookImage ]+ Right (DockerImageId imageId) -> [ DbDockerImageRawImageId ==. Just imageId ]
src/lib/Cook/State/Model.hs view
@@ -16,12 +16,14 @@ share [mkPersist sqlSettings, mkMigrate "migrateState"] [persistLowerCase| DbDockerImage+ host T.Text name T.Text rawImageId T.Text Maybe creationDate UTCTime lastUsed UTCTime usageCount Int- UniqueDbDockerImage name+ buildTimeSeconds Double+ UniqueDbDockerImage name host deriving Show DbHashCache fullPath FilePath
src/lib/Cook/Sync.hs view
@@ -3,18 +3,20 @@ import Cook.Util import Cook.State.Manager-import qualified Cook.Docker as D+import qualified Cook.DirectDocker as Docker import System.Directory+import qualified Data.Text as T runSync :: FilePath -> IO () runSync stateDir = do createDirectoryIfMissing True stateDir- reachable <- D.dockerReachable- if reachable- then do logInfo "Sync started, please wait..."- (stateManager, _) <- createStateManager stateDir- imCache <- D.newDockerImagesCache- syncImages stateManager (\v -> D.doesImageExist imCache (Left v))- logInfo "Sync complete."- else logError "Docker daemon not reachable!"+ hostInfo <- Docker.dockerInfo+ case hostInfo of+ Nothing -> logError "Docker daemon not reachable!"+ Just info ->+ do logInfo $ "Sync with " ++ T.unpack (Docker.di_name info) ++ " started, please wait..."+ (stateManager, _) <- createStateManager stateDir+ imCache <- Docker.newDockerImagesCache+ syncImages stateManager (Docker.di_id info) (\v -> Docker.doesImageExist imCache (Left v))+ logInfo "Sync complete."
src/lib/Cook/Types.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Cook.Types where +import Data.Aeson import Data.Hashable import qualified Data.ByteString as BS+import qualified Data.HashMap.Strict as HM import qualified Data.Text as T newtype DownloadUrl@@ -12,10 +14,13 @@ data CookConfig = CookConfig { cc_boringFile :: Maybe FilePath- , cc_tagprefix :: Maybe String -- additionally tag images using this prefix + cook filename- , cc_cookFileDropCount :: Int -- drop this many chars from every cook filename+ , cc_tagprefix :: Maybe String+ -- ^ additionally tag images using this prefix + cook filename+ , cc_cookFileDropCount :: Int+ -- ^ drop this many chars from every cook filename , cc_autoPush :: Bool , cc_forceRebuild :: Bool+ , cc_compileVars :: HM.HashMap T.Text T.Text , cc_buildEntryPoints :: [String] } deriving (Show, Eq) @@ -31,10 +36,12 @@ SHA1 { unSha1 :: BS.ByteString } deriving (Show, Eq) +-- | A docker image tag, eg. 'ubuntu:14.04' newtype DockerImage = DockerImage { unDockerImage :: T.Text }- deriving (Show, Eq, Hashable)+ deriving (Show, Eq, Hashable, Ord, FromJSON, ToJSON) +-- | An actual docker image id newtype DockerImageId = DockerImageId { unDockerImageId :: T.Text }- deriving (Show, Eq, Hashable)+ deriving (Show, Eq, Hashable, FromJSON, ToJSON, Ord)
src/prog/Cook/ArgParse.hs view
@@ -1,16 +1,23 @@+{-# LANGUAGE OverloadedStrings #-} module Cook.ArgParse (argParse, CookCmd(..)) where import Cook.Types++import Data.List (foldl') import Options.Applicative+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T data CookCmd = CookBuild CookConfig | CookParse [FilePath] | CookSync- | CookVersion+ | CookVersion Bool | CookInit+ | CookTiming (Either DockerImage DockerImageId) deriving (Show, Eq) +cookTagP :: Parser (Maybe String) cookTagP = optional $ strOption $@@ -36,10 +43,12 @@ value 2 <> help "log levels for 0 - 3" +cookBoringP :: Parser (Maybe String) cookBoringP = optional $ strOption ( long "ignore" <> short 'i' <> metavar "FILENAME" <> help "File with regex list of ignored files." ) +cookFilesP :: Parser [String] cookFilesP = many (argument str (metavar "COOKFILE")) @@ -50,9 +59,21 @@ <*> cookTagP <*> cookFileDropP <*> (switch (long "push" <> help "Push built docker containers"))- <*> (switch (long "force-rebuild" <> help "Rebuild all docker images regardless of dependency changes"))- <*> cookFilesP)+ <*> (switch (long "force-rebuild"+ <> help "Rebuild all docker images regardless of dependency changes"))+ <*> (packHM <$>+ many (strOption $ long "set-var"+ <> help "set a compile time environment variable. Format: NAME=value"))+ <*> cookFilesP + )+ where+ packHM =+ foldl' (\hm x ->+ let (key, val) = T.breakOn "=" (T.pack x)+ in HM.insert key (T.drop 1 val) hm+ ) HM.empty+ cookSync :: Parser CookCmd cookSync = pure CookSync @@ -60,6 +81,29 @@ cookParse = CookParse <$> cookFilesP +cookVersion :: Parser CookCmd+cookVersion =+ CookVersion+ <$> (switch $ long "numeric" <> help "Show numeric version")++cookTiming :: Parser CookCmd+cookTiming =+ CookTiming <$>+ (((Left . DockerImage . T.pack) <$> cookTag) <|> ((Right . DockerImageId . T.pack) <$> imageId))+ where+ imageId =+ strOption $+ long "by-imageid" <>+ metavar "DOCKER-IMAGE-ID" <>+ help ("Raw docker image id, eg "+ ++ "167ee78730362ee7519db49ddf13cbf9be79a2047a19468d69d1912fac368af8")+ cookTag =+ strOption $+ long "by-cooktag" <>+ metavar "COOK-IMAGE-TAG" <>+ help ("Tag given to the image by dockercook, eg "+ ++ "cook-bcff3116a3b067e4fcbbdcc1dcca6cbd67da7efa")+ argParse :: Parser (Int, CookCmd) argParse = (,) <$> cookVerboseP <*> argParse'@@ -70,6 +114,7 @@ ( command "cook" (info cookOptions ( progDesc "Cook docker images" )) <> command "check" (info cookParse ( progDesc "Validate a Dockercook file" )) <> command "sync" (info cookSync ( progDesc "Sync local state with remote docker server" ))- <> command "version" (info (pure CookVersion) ( progDesc "Show programs version" ))+ <> command "version" (info cookVersion ( progDesc "Show programs version" ))+ <> command "timing" (info cookTiming ( progDesc "Looking build times for image" )) <> command "init" (info (pure CookInit) ( progDesc "Enable dockercook for current project / directory" )) )
src/prog/Main.hs view
@@ -1,7 +1,7 @@ module Main where import Paths_dockercook (version)-import Data.Version (showVersion)+import Data.Version (showVersion, versionBranch) import Cook.ArgParse import Cook.Build@@ -11,6 +11,8 @@ import Cook.Util import Cook.State.Manager +import Data.List (foldl')+import Data.Aeson.Encode.Pretty (encodePretty) import Control.Monad import Options.Applicative import System.Exit@@ -18,6 +20,9 @@ import System.Directory import System.FilePath import System.Process+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T runProg :: (Int, CookCmd) -> IO () runProg (verb, cmd) =@@ -57,12 +62,20 @@ runSync stateDir CookParse files -> mapM_ cookParse files- CookVersion ->- putStrLn ("dockercook " ++ showVersion version)+ CookVersion showNumeric ->+ if showNumeric+ then print (foldl' (\v (vers, pos) -> v + vers * (10 ^ (2*pos))) 0 $+ zip (reverse $ versionBranch version) ([0..] :: [Integer]))+ else putStrLn ("dockercook " ++ showVersion version) CookInit -> do createDirectoryIfMissing True _STATE_DIR_NAME_ _ <- createStateManager _STATE_DIR_NAME_ putStrLn "My kitchen is ready for cooking!"+ CookTiming opt ->+ do stateDir <- findStateDirectory+ (mgr, _) <- createStateManager stateDir+ res <- getImageBuildTime mgr opt+ T.putStrLn $ T.decodeUtf8 $ BSL.toStrict $ encodePretty res main :: IO () main =
src/test/Tests.hs view
@@ -3,6 +3,7 @@ import Test.Framework import {-@ HTF_TESTS @-} Tests.BuildFile+import {-@ HTF_TESTS @-} Tests.DirectDocker main :: IO () main = htfMain htf_importedTests
src/test/Tests/BuildFile.hs view
@@ -4,12 +4,10 @@ import Cook.BuildFile import Cook.Types-import Paths_dockercook import Test.Framework import qualified Data.Vector as V import qualified Data.Text as T-import qualified Data.Text.IO as T test_matchFilePattern :: IO () test_matchFilePattern =@@ -26,19 +24,13 @@ Right pattern2 = parseFilePattern "foo/*.cabal" Right pattern3 = parseFilePattern "foo/*" -readDataFile :: String -> IO T.Text-readDataFile name =- do fp <- getDataFileName name- T.readFile fp- test_parseBuildFile :: IO () test_parseBuildFile = do parsed1 <- parseBuildFileText "sample1" sampleFile1 >>= assertRight parsed2 <- parseBuildFileText "sample1" sampleFile2 >>= assertRight parsed3 <- parseBuildFileText "sample3" sampleFile3 >>= assertRight parsed4 <- parseBuildFileText "sample3" sampleFile4 >>= assertRight- sampleFile5 <- readDataFile "test1.cook"- parsed5 <- parseBuildFileText "test1.cook" sampleFile5 >>= assertRight+ parsed5 <- parseBuildFile "test/parsefail02.cook" >>= assertRight assertEqual (BuildBaseDocker $ DockerImage "ubuntu:14.04") (bf_base parsed1) assertEqual parsed1 parsed2 assertEqual (BuildBaseCook $ BuildFileId "foo.build") (bf_base parsed3)@@ -76,3 +68,41 @@ , "# comment\n" , "\n" ]++test_parseCookVar :: IO ()+test_parseCookVar =+ do parsed1 <- parseBuildFileText "sample1" sampleFile1 >>= assertRight+ assertEqual expected1 parsed1+ parsed2 <- parseBuildFileText "sample2" sampleFile2 >>= assertRight+ assertEqual expected2 parsed2+ where+ expected2 =+ expected1+ { bf_requiredVars = V.fromList [("BUILD_MODE", Just "fast")]+ , bf_name = BuildFileId "sample2"+ }+ expected1 =+ (emptyBuildFile (BuildFileId "sample1") (BuildBaseCook $ BuildFileId "foo.bar"))+ { bf_requiredVars = V.fromList [("BUILD_MODE", Nothing)]+ , bf_dockerCommands =+ V.fromList+ [Right $ DockerCommand "RUN" "echo $BUILD_MODE"]+ }+ sampleFile1 =+ T.unlines+ [ "BASE COOK foo.bar"+ , "COOKVAR BUILD_MODE"+ , "RUN echo $BUILD_MODE"+ ]+ sampleFile2 =+ T.unlines+ [ "BASE COOK foo.bar"+ , "COOKVAR BUILD_MODE fast"+ , "RUN echo $BUILD_MODE"+ ]++test_parseBuildAdvanced :: IO ()+test_parseBuildAdvanced =+ do t1 <- parseBuildFile "test/parsefail01.cook"+ _ <- assertRight t1+ return ()
+ src/test/Tests/DirectDocker.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+module Tests.DirectDocker (htf_thisModulesTests) where++import Cook.DirectDocker+import Test.Framework++test_parseDockerTag :: IO ()+test_parseDockerTag =+ do assertEqual (DockerTag "ubuntu" (DockerTagVersionOther "14.04"))+ (parseDockerTag "ubuntu:14.04")+ assertEqual (DockerTag "cook-5b520704fb2246ec2f688e708edba1e0ad7438" DockerTagVersionLatest)+ (parseDockerTag "cook-5b520704fb2246ec2f688e708edba1e0ad7438")+ assertEqual (DockerTag "reg.foo.bar:5000/someimage" DockerTagVersionLatest)+ (parseDockerTag "reg.foo.bar:5000/someimage")+ assertEqual (DockerTag "reg.foo.bar:5000/someimage" $ DockerTagVersionOther "vers")+ (parseDockerTag "reg.foo.bar:5000/someimage:vers")+ assertEqual (DockerTag "<none>" DockerTagVersionNone)+ (parseDockerTag "<none>:<none>")
+ test/parsefail01.cook view
@@ -0,0 +1,6 @@+BASE COOK 020_ghc.cook++# test+# test++RUN "ok"
+ test/parsefail02.cook view
@@ -0,0 +1,32 @@+BASE COOK 030_dev.cook++INCLUDE 3rdParty/*+INCLUDE scripts/sbt+INCLUDE scripts/sbt-launch-0.11.1.jar+INCLUDE build.sbt+INCLUDE project/build.properties +INCLUDE project/build.sbt +INCLUDE project/Build.scala+INCLUDE project/plugins.sbt+INCLUDE project/DbMetaSpec.scala +INCLUDE project/DbSpec.scala ++UNPACK /DociData++# install binary dependencies+RUN apt-get install -y imagemagick++# dcmtk+RUN cd /tmp && wget -O dcmtk.tar.bz2 ftp://dicom.offis.de/pub/dicom/offis/software/dcmtk/dcmtk360/bin/dcmtk-3.6.0-linux-i686-static.tar.bz2+RUN cd /tmp && tar -xvf dcmtk.tar.bz2+RUN cp -R /tmp/dcmtk-3.6.0-linux-i686-static/* /usr/local/+RUN rm -rf /tmp/dcmtk*++# build DociData 3rdParty+WORKDIR /DociData+RUN wget -O /tmp/DociCache http://10.20.100.2/DociData-lib.tar.gz+RUN tar xzvf /tmp/DociCache -C .+RUN 3rdParty/build.sh++# build DociData dependencies+RUN scripts/sbt update