dockercook 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+56/−19 lines, 5 filesdep ~attoparsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

Files

• dockercook.cabal +1/−1
• src/lib/Cook/Build.hs +32/−17
• src/lib/Cook/Types.hs +3/−0
• src/lib/Cook/Util.hs +19/−0
• src/prog/Main.hs +1/−1

@@ -1,5 +1,5 @@ name:                dockercook-version:             0.1.1.0+version:             0.1.2.0 synopsis:            A build tool for multiple docker image layers description:         Build and manage multiple docker image layers to speed up deployment license:             MIT

@@ -18,7 +18,7 @@ import System.Directory import System.Exit import System.FilePath-import System.IO (hPutStr, hPutStrLn, stderr)+import System.IO (hPutStr, hPutStrLn, hFlush, stderr) import System.IO.Temp import System.Process import Text.Regex (mkRegex, matchRegex)@@ -68,19 +68,19 @@                  liftIO $ hPutStr stderr "."                  return $ Just (relToCurrentF, quickHash bs) -buildImage :: CookConfig -> StateManager -> [(FP.FilePath, SHA1)] -> BuildFile -> IO DockerImage-buildImage cfg@(CookConfig{..}) stateManager fileHashes bf =+buildImage :: Maybe StreamHook -> CookConfig -> StateManager -> [(FP.FilePath, SHA1)] -> BuildFile -> IO DockerImage+buildImage mStreamHook cfg@(CookConfig{..}) stateManager fileHashes bf =     do baseImage <-            case bf_base bf of              (BuildBaseCook parentBuildFile) ->                  do parent <- prepareEntryPoint cc_buildFileDir parentBuildFile-                    buildImage cfg stateManager fileHashes parent+                    buildImage mStreamHook cfg stateManager fileHashes parent              (BuildBaseDocker rootImage) ->                  do baseExists <- dockerImageExists rootImage                     if baseExists                     then do markUsingImage stateManager rootImage Nothing                             return rootImage-                    else do logInfo $ "Downloading the root image " ++ show (unDockerImage rootImage) ++ "... "+                    else do logInfo' $ "Downloading the root image " ++ show (unDockerImage rootImage) ++ "... "                             (ec, stdOut, _) <-                                 readProcessWithExitCode "docker" ["pull", T.unpack $ unDockerImage rootImage] ""                             if ec == ExitSuccess@@ -99,23 +99,38 @@            buildFileHash = quickHash [BSC.pack (show bf)]            superHash = B16.encode $ unSha1 $ quickHash (map unSha1 (dockerHash : buildFileHash : allFHashes))            imageName = DockerImage $ T.concat ["cook-", T.decodeUtf8 superHash]-       logInfo $ "Image name will be " ++ (T.unpack $ unDockerImage imageName)+       logInfo $ "Include files: " ++ (show $ length targetedFiles)+                   ++ " FileHashCount: " ++ (show $ length allFHashes)+                   ++ " Docker: " ++ (show $ B16.encode $ unSha1 dockerHash)+                   ++ " BuildFile: " ++ (show $ B16.encode $ unSha1 buildFileHash)+       logInfo' $ "Image name will be " ++ (T.unpack $ unDockerImage imageName)        let markImage = markUsingImage stateManager imageName (Just baseImage)        imageExists <- dockerImageExists imageName        if imageExists-       then do logInfo "The image already exists!"+       then do logInfo' "The image already exists!"                markImage                return imageName-       else do logInfo "Image not found!"+       else do logInfo' "Image not found!"                x <- launchImageBuilder dockerBS imageName                markImage                return x     where+      logInfo' m =+          do logInfo m+             case mStreamHook of+               Nothing -> return ()+               Just (StreamHook hook) -> hook (BSC.pack (m ++ "\n"))+      streamHook bs =+          do hPutStr stderr (BSC.unpack bs)+             hFlush stderr+             case mStreamHook of+               Nothing -> return ()+               Just (StreamHook hook) -> hook bs       dockerImageExists localIm@(DockerImage imageName) =-          do logInfo $ "Checking if the image " ++ show imageName ++ " is already present... "+          do logInfo' $ "Checking if the image " ++ show imageName ++ " is already present... "              known <- isImageKnown stateManager localIm              if known-             then do logInfo $ "Image " ++ show imageName ++ " is registered in your state directory. Assuming it is present!"+             then do logInfo' $ "Image " ++ show imageName ++ " is registered in your state directory. Assuming it is present!"                      return True              else do (ec, stdOut, _) <- readProcessWithExitCode "docker" ["images"] ""                      let imageLines = T.lines $ T.pack stdOut@@ -144,16 +159,16 @@                            putStrLn ("cp " ++ copySrc ++ " " ++ targetSrc)                            copyFile copySrc targetSrc                    ) targetedFiles-             logInfo "Writing Dockerfile ..."+             logInfo' "Writing Dockerfile ..."              BS.writeFile (tempDir </> "Dockerfile") dockerBS-             logInfo ("Building docker container...")+             logInfo' ("Building docker container...")              let tag = T.unpack $ unDockerImage imageName-             ecDocker <- system $ "docker build --rm -t " ++ tag ++ " " ++ tempDir+             ecDocker <- systemStream ("docker build --rm -t " ++ tag ++ " " ++ tempDir) streamHook              if ecDocker == ExitSuccess                then return imageName                else do hPutStrLn stderr ("Failed to build " ++ tag ++ "!")                        hPutStrLn stderr ("Saving temp directory to COOKFAILED.")-                       _ <- system $ "rm -rf COOKFAILED; cp -r " ++ tempDir ++ " COOKFAILED"+                       _ <- systemStream ("rm -rf COOKFAILED; cp -r " ++ tempDir ++ " COOKFAILED") streamHook                        exitWith ecDocker       localName fp =           case FP.stripPrefix (FP.decodeString $ fixTailingSlash cc_dataDir) fp of@@ -164,14 +179,14 @@       targetedFiles = filter (\(fp, _) -> isNeededHash fp) fileHashes  -cookBuild :: CookConfig -> IO [DockerImage]-cookBuild cfg@(CookConfig{..}) =+cookBuild :: CookConfig -> Maybe StreamHook -> IO [DockerImage]+cookBuild cfg@(CookConfig{..}) mStreamHook =     do stateManager <- createStateManager cc_stateDir        boring <- liftM (fromMaybe []) $ T.mapM (liftM parseBoring . T.readFile) cc_boringFile        fileHashes <- makeDirectoryFileHashTable (isBoring boring)  cc_dataDir        roots <-            mapM ((prepareEntryPoint cc_buildFileDir) . BuildFileId . T.pack) cc_buildEntryPoints-       res <- mapM (buildImage cfg stateManager fileHashes) roots+       res <- mapM (buildImage mStreamHook cfg stateManager fileHashes) roots        logInfo "All done!"        return res     where

@@ -15,6 +15,9 @@    , cc_buildEntryPoints :: [String]    } deriving (Show, Eq) +newtype StreamHook =+    StreamHook { unStreamHook :: BS.ByteString -> IO () }+ newtype SHA1 =     SHA1 { unSha1 :: BS.ByteString }          deriving (Show, Eq)

@@ -1,10 +1,29 @@ module Cook.Util where +import Data.Conduit+import Data.Conduit.Process import Control.Monad.Trans+import System.Exit import System.IO (hPutStrLn, stderr) +import qualified Data.ByteString as BS+ logInfo :: MonadIO m => String -> m () logInfo = liftIO . hPutStrLn stderr  logDebug :: MonadIO m => String -> m () logDebug _ = return ()++systemStream :: String -> (BS.ByteString -> IO ()) -> IO ExitCode+systemStream cmd onOutput =+    do (ec, _) <- sourceCmdWithConsumer cmd conduitRead+       return ec+    where+      conduitRead =+          do mBS <- await+             case mBS of+               Just bs ->+                   do liftIO $ onOutput bs+                      conduitRead+               Nothing ->+                   return ()

@@ -9,7 +9,7 @@ runProg cmd =     case cmd of       CookBuild buildCfg ->-          do _ <- cookBuild buildCfg+          do _ <- cookBuild buildCfg Nothing              return ()       CookClean stateDir daysToKeep ->           cookClean stateDir daysToKeep